From 36d4f7f64d61a4e7c91d3ce3277073736bdfa15f Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Sat, 4 Dec 2021 10:15:58 -0500 Subject: [PATCH 01/73] Bugfix: cpu clock sync error This patch fixes an error in the `sync` flag of the cpu clocks. Previously, we would set the sync bit of a flag based on the presence of sync, rather than testing if the value was true. This would cause potential hangs in any clock that set `sync`, including `.false.`. This patch correctly replaces the single `ibset` call with an if-block to either `ibset` or `ibclr`. --- config_src/infra/FMS1/MOM_cpu_clock_infra.F90 | 9 +++++++-- config_src/infra/FMS2/MOM_cpu_clock_infra.F90 | 9 +++++++-- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/config_src/infra/FMS1/MOM_cpu_clock_infra.F90 b/config_src/infra/FMS1/MOM_cpu_clock_infra.F90 index 62c21e5772..0c42c577b4 100644 --- a/config_src/infra/FMS1/MOM_cpu_clock_infra.F90 +++ b/config_src/infra/FMS1/MOM_cpu_clock_infra.F90 @@ -85,8 +85,13 @@ integer function cpu_clock_id(name, sync, grain) integer :: clock_flags clock_flags = clock_flag_default - if (present(sync)) & - clock_flags = ibset(clock_flags, 0) + if (present(sync)) then + if (sync) then + clock_flags = ibset(clock_flags, 0) + else + clock_flags = ibclr(clock_flags, 0) + endif + endif cpu_clock_id = mpp_clock_id(name, flags=clock_flags, grain=grain) end function cpu_clock_id diff --git a/config_src/infra/FMS2/MOM_cpu_clock_infra.F90 b/config_src/infra/FMS2/MOM_cpu_clock_infra.F90 index 62c21e5772..0c42c577b4 100644 --- a/config_src/infra/FMS2/MOM_cpu_clock_infra.F90 +++ b/config_src/infra/FMS2/MOM_cpu_clock_infra.F90 @@ -85,8 +85,13 @@ integer function cpu_clock_id(name, sync, grain) integer :: clock_flags clock_flags = clock_flag_default - if (present(sync)) & - clock_flags = ibset(clock_flags, 0) + if (present(sync)) then + if (sync) then + clock_flags = ibset(clock_flags, 0) + else + clock_flags = ibclr(clock_flags, 0) + endif + endif cpu_clock_id = mpp_clock_id(name, flags=clock_flags, grain=grain) end function cpu_clock_id From e48f4a7f42f4e28cc5ac2b2dee5327617eeedec2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 6 Dec 2021 10:58:13 -0500 Subject: [PATCH 02/73] +Add the new routine unit_no_scaling_init Added the public interface unit_no_scaling_init() to the MOM_unit_scaling module to initialize a non-scaling unit_scale_type without requiring a param_file_type argument. This should be useful for certain trivial unit tests, and it makes it more plausible to make the unit_scale_type arguments mandatory. As a part of this change, the new internal subroutine set_unit_scaling_combos() was carved out of unit_scaling_init to avoid code duplication. Also added comments describing the effective units of the various scaling factors with the standard MOM6 notation. All answers and output are bitwise identical. --- src/framework/MOM_unit_scaling.F90 | 93 ++++++++++++++++++++---------- 1 file changed, 63 insertions(+), 30 deletions(-) diff --git a/src/framework/MOM_unit_scaling.F90 b/src/framework/MOM_unit_scaling.F90 index dbcd2405ec..cd339f410c 100644 --- a/src/framework/MOM_unit_scaling.F90 +++ b/src/framework/MOM_unit_scaling.F90 @@ -8,39 +8,47 @@ module MOM_unit_scaling implicit none ; private -public unit_scaling_init, unit_scaling_end, fix_restart_unit_scaling +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, T, R and Q, along with +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the rescaled +! combination is a nondimensional variable, the notation would be "a slope [Z L-1 ~> nondim]", +! but if (as the case for the variables here), the rescaled combination is exactly 1, the right +! notation would be something like "a dimensional scaling factor [Z m-1 ~> 1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. + +public unit_scaling_init, unit_no_scaling_init, unit_scaling_end, fix_restart_unit_scaling !> Describes various unit conversion factors type, public :: unit_scale_type - real :: m_to_Z !< A constant that translates distances in meters to the units of depth. - real :: Z_to_m !< A constant that translates distances in the units of depth to meters. - real :: m_to_L !< A constant that translates lengths in meters to the units of horizontal lengths. - real :: L_to_m !< A constant that translates lengths in the units of horizontal lengths to meters. - real :: s_to_T !< A constant that translates time intervals in seconds to the units of time. - real :: T_to_s !< A constant that translates the units of time to seconds. - real :: R_to_kg_m3 !< A constant that translates the units of density to kilograms per meter cubed. - real :: kg_m3_to_R !< A constant that translates kilograms per meter cubed to the units of density. - real :: Q_to_J_kg !< A constant that translates the units of enthalpy to Joules per kilogram. - real :: J_kg_to_Q !< A constant that translates Joules per kilogram to the units of enthalpy. + real :: m_to_Z !< A constant that translates distances in meters to the units of depth [Z m-1 ~> 1] + real :: Z_to_m !< A constant that translates distances in the units of depth to meters [m Z-1 ~> 1] + real :: m_to_L !< A constant that translates lengths in meters to the units of horizontal lengths [L m-1 ~> 1] + real :: L_to_m !< A constant that translates lengths in the units of horizontal lengths to meters [m L-1 ~> 1] + real :: s_to_T !< A constant that translates time intervals in seconds to the units of time [T s-1 ~> 1] + real :: T_to_s !< A constant that translates the units of time to seconds [s T-1 ~> 1] + real :: R_to_kg_m3 !< A constant that translates the units of density to kilograms per meter cubed [kg m-3 R-1 ~> 1] + real :: kg_m3_to_R !< A constant that translates kilograms per meter cubed to the units of density [R m3 kg-1 ~> 1] + real :: Q_to_J_kg !< A constant that translates the units of enthalpy to Joules per kilogram [J kg-1 Q-1 ~> 1] + real :: J_kg_to_Q !< A constant that translates Joules per kilogram to the units of enthalpy [Q kg J-1 ~> 1] ! These are useful combinations of the fundamental scale conversion factors above. - real :: Z_to_L !< Convert vertical distances to lateral lengths - real :: L_to_Z !< Convert lateral lengths to vertical distances - real :: L_T_to_m_s !< Convert lateral velocities from L T-1 to m s-1. - real :: m_s_to_L_T !< Convert lateral velocities from m s-1 to L T-1. - real :: L_T2_to_m_s2 !< Convert lateral accelerations from L T-2 to m s-2. - real :: Z2_T_to_m2_s !< Convert vertical diffusivities from Z2 T-1 to m2 s-1. - real :: m2_s_to_Z2_T !< Convert vertical diffusivities from m2 s-1 to Z2 T-1. - real :: W_m2_to_QRZ_T !< Convert heat fluxes from W m-2 to Q R Z T-1. - real :: QRZ_T_to_W_m2 !< Convert heat fluxes from Q R Z T-1 to W m-2. - ! Not used enough: real :: kg_m2_to_RZ !< Convert mass loads from kg m-2 to R Z. - real :: RZ_to_kg_m2 !< Convert mass loads from R Z to kg m-2. - real :: kg_m2s_to_RZ_T !< Convert mass fluxes from kg m-2 s-1 to R Z T-1. - real :: RZ_T_to_kg_m2s !< Convert mass fluxes from R Z T-1 to kg m-2 s-1. - real :: RZ3_T3_to_W_m2 !< Convert turbulent kinetic energy fluxes from R Z3 T-3 to W m-2. - real :: W_m2_to_RZ3_T3 !< Convert turbulent kinetic energy fluxes from W m-2 to R Z3 T-3. - real :: RL2_T2_to_Pa !< Convert pressures from R L2 T-2 to Pa. - ! Not used enough: real :: Pa_to_RL2_T2 !< Convert pressures from Pa to R L2 T-2. + real :: Z_to_L !< Convert vertical distances to lateral lengths [L Z-1 ~> 1] + real :: L_to_Z !< Convert lateral lengths to vertical distances [Z L-1 ~> 1] + real :: L_T_to_m_s !< Convert lateral velocities from L T-1 to m s-1 [T m L-1 s-1 ~> 1] + real :: m_s_to_L_T !< Convert lateral velocities from m s-1 to L T-1 [L s T-1 m-1 ~> 1] + real :: L_T2_to_m_s2 !< Convert lateral accelerations from L T-2 to m s-2 [L s2 T-2 m-1 ~> 1] + real :: Z2_T_to_m2_s !< Convert vertical diffusivities from Z2 T-1 to m2 s-1 [T1 m2 Z-2 s-1 ~> 1] + real :: m2_s_to_Z2_T !< Convert vertical diffusivities from m2 s-1 to Z2 T-1 [Z2 s T-1 m-2 ~> 1] + real :: W_m2_to_QRZ_T !< Convert heat fluxes from W m-2 to Q R Z T-1 [Q R Z m2 T-1 W-1 ~> 1] + real :: QRZ_T_to_W_m2 !< Convert heat fluxes from Q R Z T-1 to W m-2 [W T Q-1 R-1 Z-1 m-2 ~> 1] + ! Not used enough: real :: kg_m2_to_RZ !< Convert mass loads from kg m-2 to R Z [R Z m2 kg-1 ~> 1] + real :: RZ_to_kg_m2 !< Convert mass loads from R Z to kg m-2 [kg R-1 Z-1 m-2 ~> 1] + real :: kg_m2s_to_RZ_T !< Convert mass fluxes from kg m-2 s-1 to R Z T-1 [R Z m2 s T-1 kg-1 ~> 1] + real :: RZ_T_to_kg_m2s !< Convert mass fluxes from R Z T-1 to kg m-2 s-1 [T kg R-1 Z-1 m-2 s-1 ~> 1] + real :: RZ3_T3_to_W_m2 !< Convert turbulent kinetic energy fluxes from R Z3 T-3 to W m-2 [W T3 R-1 Z-3 m-2 ~> 1] + real :: W_m2_to_RZ3_T3 !< Convert turbulent kinetic energy fluxes from W m-2 to R Z3 T-3 [R Z3 m2 T-3 W-1 ~> 1] + real :: RL2_T2_to_Pa !< Convert pressures from R L2 T-2 to Pa [Pa T2 R-1 L-2 ~> 1] + ! Not used enough: real :: Pa_to_RL2_T2 !< Convert pressures from Pa to R L2 T-2 [R L2 T-2 Pa-1 ~> 1] ! These are used for changing scaling across restarts. real :: m_to_Z_restart = 0.0 !< A copy of the m_to_Z that is used in restart files. @@ -130,7 +138,32 @@ subroutine unit_scaling_init( param_file, US ) US%Q_to_J_kg = 1.0 * Q_Rescale_factor US%J_kg_to_Q = 1.0 / Q_Rescale_factor - ! These are useful combinations of the fundamental scale conversion factors set above. + call set_unit_scaling_combos(US) +end subroutine unit_scaling_init + +!> Allocates and initializes the ocean model unit scaling type to unscaled values. +subroutine unit_no_scaling_init(US) + type(unit_scale_type), pointer :: US !< A dimensional unit scaling type + + if (associated(US)) call MOM_error(FATAL, & + 'unit_scaling_init: called with an associated US pointer.') + allocate(US) + + US%Z_to_m = 1.0 ; US%m_to_Z = 1.0 + US%L_to_m = 1.0 ; US%m_to_L = 1.0 + US%T_to_s = 1.0 ; US%s_to_T = 1.0 + US%R_to_kg_m3 = 1.0 ; US%kg_m3_to_R = 1.0 + US%Q_to_J_kg = 1.0 ; US%J_kg_to_Q = 1.0 + + call set_unit_scaling_combos(US) +end subroutine unit_no_scaling_init + +!> This subroutine sets useful combinations of the fundamental scale conversion factors +!! in the unit scaling type. +subroutine set_unit_scaling_combos(US) + type(unit_scale_type), intent(inout) :: US !< A dimensional unit scaling type + + ! Convert vertical to horizontal length scales and the reverse: US%Z_to_L = US%Z_to_m * US%m_to_L US%L_to_Z = US%L_to_m * US%m_to_Z ! Horizontal velocities: @@ -159,7 +192,7 @@ subroutine unit_scaling_init( param_file, US ) ! It does not seem like US%Pa_to_RL2_T2 would be used enough in MOM6 to justify its existence. ! US%Pa_to_RL2_T2 = US%kg_m3_to_R * US%m_s_to_L_T**2 -end subroutine unit_scaling_init +end subroutine set_unit_scaling_combos !> Set the unit scaling factors for output to restart files to the unit scaling !! factors for this run. From 59c592649bc404cf933b88b988077f7ecdf9bd65 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 6 Dec 2021 11:50:39 -0500 Subject: [PATCH 03/73] (*)Provide US arguments to 4 existing calls Provide optional US arguments to 4 existing calls to set_grid_metrics() and MOM_initialize_topography(), enabling these arguments to become mandatory in the next commit. In some cases this requires a call to unit_no_scaling_init() or the removal of a call to rescale_dyn_horgrid_bathymetry(). In addition, a mis-scaled value was corrected in the initialization of the ODA control structures private thickness array; this latter issue is not a problem for Boussinesq models without dimensional rescaling (i.e. the tested cases), but could change answers in other cases with data assimilation. All answers in the MOM6-examples or TC test cases are bitwise identical. --- config_src/drivers/unit_drivers/MOM_sum_driver.F90 | 7 ++++++- src/ice_shelf/MOM_ice_shelf.F90 | 6 ++---- src/ocean_data_assim/MOM_oda_driver.F90 | 8 ++++---- 3 files changed, 12 insertions(+), 9 deletions(-) diff --git a/config_src/drivers/unit_drivers/MOM_sum_driver.F90 b/config_src/drivers/unit_drivers/MOM_sum_driver.F90 index 7291eb913a..9f3950ac7f 100644 --- a/config_src/drivers/unit_drivers/MOM_sum_driver.F90 +++ b/config_src/drivers/unit_drivers/MOM_sum_driver.F90 @@ -29,6 +29,7 @@ program MOM_main use MOM_io, only : MOM_io_init, file_exists, open_file, close_file use MOM_io, only : check_nml_error, io_infra_init, io_infra_end use MOM_io, only : APPEND_FILE, ASCII_FILE, READONLY_FILE, SINGLE_FILE + use MOM_unit_scaling, only : unit_scale_type, unit_no_scaling_init, unit_scaling_end implicit none @@ -39,6 +40,8 @@ program MOM_main type(hor_index_type) :: HI ! A hor_index_type for array extents type(param_file_type) :: param_file ! The structure indicating the file(s) ! containing all run-time parameters. + type(unit_scale_type), pointer :: US => NULL() !< A structure containing various unit + ! conversion factors, but in this case all are 1. real :: max_depth ! The maximum ocean depth [m] integer :: verbosity integer :: num_sums @@ -104,7 +107,8 @@ program MOM_main allocate(depth_tot_fastR(num_sums)) ; depth_tot_fastR(:) = 0.0 ! Set up the parameters of the physical grid - call set_grid_metrics(grid, param_file) + call unit_no_scaling_init(US) + call set_grid_metrics(grid, param_file, US) ! Set up the bottom depth, grid%bathyT either analytically or from file call get_param(param_file, "MOM", "MAXIMUM_DEPTH", max_depth, & @@ -162,6 +166,7 @@ program MOM_main enddo call destroy_dyn_horgrid(grid) + call unit_scaling_end(US) call io_infra_end ; call MOM_infra_end contains diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 77166cece0..674b84807d 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -21,7 +21,6 @@ module MOM_ice_shelf use MOM_domains, only : MOM_domains_init, pass_var, pass_vector, clone_MOM_domain use MOM_domains, only : TO_ALL, CGRID_NE, BGRID_NE, CORNER use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid -use MOM_dyn_horgrid, only : rescale_dyn_horgrid_bathymetry use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_file_parser, only : read_param, get_param, log_param, log_version, param_file_type use MOM_grid, only : MOM_grid_init, ocean_grid_type @@ -1306,9 +1305,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, call create_dyn_horgrid(dG, CS%Grid%HI) call clone_MOM_domain(CS%Grid%Domain,dG%Domain) call set_grid_metrics(dG,param_file,CS%US) - ! Set up the bottom depth, G%D either analytically or from file - call MOM_initialize_topography(dG%bathyT, CS%Grid%max_depth, dG, param_file) - call rescale_dyn_horgrid_bathymetry(dG, CS%US%Z_to_m) + ! Set up the bottom depth, dG%bathyT, either analytically or from file + call MOM_initialize_topography(dG%bathyT, CS%Grid%max_depth, dG, param_file, CS%US) call copy_dyngrid_to_MOM_grid(dG, CS%Grid, CS%US) call destroy_dyn_horgrid(dG) ! endif diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 161cf16115..d5259d760a 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -278,8 +278,8 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) allocate(dG) call create_dyn_horgrid(dG, HI) call clone_MOM_domain(CS%Grid%Domain, dG%Domain,symmetric=.false.) - call set_grid_metrics(dG,PF) - call MOM_initialize_topography(dg%bathyT,dG%max_depth,dG,PF) + call set_grid_metrics(dG, PF, CS%US) + call MOM_initialize_topography(dG%bathyT, dG%max_depth, dG, PF, CS%US) call MOM_initialize_coord(CS%GV, CS%US, PF, .false., & dirs%output_directory, tv_dummy, dG%max_depth) call ALE_init(PF, CS%GV, CS%US, dG%max_depth, CS%ALE_CS) @@ -313,9 +313,9 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) !jsd=jsd+jdg_offset; jed=jed+jdg_offset ! TODO: switch to local indexing? (mjh) if (.not. associated(CS%h)) then - allocate(CS%h(isd:ied,jsd:jed,CS%GV%ke), source=CS%GV%Angstrom_m*CS%GV%H_to_m) + allocate(CS%h(isd:ied,jsd:jed,CS%GV%ke), source=CS%GV%Angstrom_H) ! assign thicknesses - call ALE_initThicknessToCoord(CS%ALE_CS,G,CS%GV,CS%h) + call ALE_initThicknessToCoord(CS%ALE_CS, G, CS%GV, CS%h) endif allocate(CS%tv) allocate(CS%tv%T(isd:ied,jsd:jed,CS%GV%ke), source=0.0) From 3162bd08690b518633ab66bd8c37ebe3125616d6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 6 Dec 2021 11:57:20 -0500 Subject: [PATCH 04/73] +Make US arguments non-optional for 28 routines Made the unit_scale_type arguments non-optional for 28 routines. These arguments had been optional in the first place to manage the coordination between the MOM6 and SIS2 repositories, but SIS2 has been using these optional arguments for several years now, and they can be made mandatory without imposing any disruptions. This change simplifies and clarifies the code. All answers and output are bitwise identical. --- src/core/MOM_checksum_packages.F90 | 8 +- .../MOM_fixed_initialization.F90 | 15 +- src/initialization/MOM_grid_initialize.F90 | 105 +++----- .../MOM_shared_initialization.F90 | 252 +++++++----------- .../MOM_state_initialization.F90 | 2 +- src/user/DOME_initialization.F90 | 15 +- src/user/ISOMIP_initialization.F90 | 15 +- src/user/Kelvin_initialization.F90 | 11 +- src/user/Phillips_initialization.F90 | 10 +- src/user/benchmark_initialization.F90 | 13 +- src/user/shelfwave_initialization.F90 | 15 +- src/user/user_initialization.F90 | 6 +- 12 files changed, 189 insertions(+), 278 deletions(-) diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index be00de8779..917a4afdc3 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -92,23 +92,21 @@ subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, US, haloshift, symmetric) intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] or [m s-1].. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type, which is + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type, which is !! used to rescale u and v if present. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0). logical, optional, intent(in) :: symmetric !< If true, do checksums on the fully !! symmetric computational domain. - real :: L_T_to_m_s ! A rescaling factor for velocities [m T s-1 L-1 ~> 1] or [1] + integer :: hs logical :: sym - L_T_to_m_s = 1.0 ; if (present(US)) L_T_to_m_s = US%L_T_to_m_s - ! Note that for the chksum calls to be useful for reproducing across PE ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. hs = 1 ; if (present(haloshift)) hs = haloshift sym = .false. ; if (present(symmetric)) sym = symmetric - call uvchksum(mesg//" u", u, v, G%HI, haloshift=hs, symmetric=sym, scale=L_T_to_m_s) + call uvchksum(mesg//" u", u, v, G%HI, haloshift=hs, symmetric=sym, scale=US%L_T_to_m_s) call hchksum(h, mesg//" h",G%HI, haloshift=hs, scale=GV%H_to_m) end subroutine MOM_state_chksum_3arg diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index b67d21ebcb..f0fb1d23f9 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -6,7 +6,7 @@ module MOM_fixed_initialization use MOM_debugging, only : hchksum, qchksum, uvchksum use MOM_domains, only : pass_var -use MOM_dyn_horgrid, only : dyn_horgrid_type, rescale_dyn_horgrid_bathymetry +use MOM_dyn_horgrid, only : dyn_horgrid_type use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint use MOM_file_parser, only : get_param, read_param, log_param, param_file_type @@ -82,7 +82,6 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) ! This also sets G%max_depth based on the input parameter MAXIMUM_DEPTH, ! or, if absent, is diagnosed as G%max_depth = max( G%D(:,:) ) call MOM_initialize_topography(G%bathyT, G%max_depth, G, PF, US) -! call rescale_dyn_horgrid_bathymetry(G, US%Z_to_m) ! To initialize masks, the bathymetry in halo regions must be filled in call pass_var(G%bathyT, G%Domain) @@ -174,20 +173,16 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF, US) intent(out) :: D !< Ocean bottom depth [Z ~> m] or [m] type(param_file_type), intent(in) :: PF !< Parameter file structure real, intent(out) :: max_depth !< Maximum depth of model [Z ~> m] or [m] - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! This subroutine makes the appropriate call to set up the bottom depth. ! This is a separate subroutine so that it can be made public and shared with ! the ice-sheet code or other components. ! Local variables - real :: m_to_Z, Z_to_m ! Dimensional rescaling factors character(len=40) :: mdl = "MOM_initialize_topography" ! This subroutine's name. character(len=200) :: config - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - Z_to_m = 1.0 ; if (present(US)) Z_to_m = US%Z_to_m - call get_param(PF, mdl, "TOPO_CONFIG", config, & "This specifies how bathymetry is specified: \n"//& " \t file - read bathymetric information from the file \n"//& @@ -216,7 +211,7 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF, US) " \t dense - Denmark Strait-like dense water formation and overflow.\n"//& " \t USER - call a user modified routine.", & fail_if_missing=.true.) - max_depth = -1.e9*m_to_Z ; call read_param(PF, "MAXIMUM_DEPTH", max_depth, scale=m_to_Z) + max_depth = -1.e9*US%m_to_Z ; call read_param(PF, "MAXIMUM_DEPTH", max_depth, scale=US%m_to_Z) select case ( trim(config) ) case ("file"); call initialize_topography_from_file(D, G, PF, US) case ("flat"); call initialize_topography_named(D, G, PF, config, max_depth, US) @@ -241,11 +236,11 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF, US) "Unrecognized topography setup '"//trim(config)//"'") end select if (max_depth>0.) then - call log_param(PF, mdl, "MAXIMUM_DEPTH", max_depth*Z_to_m, & + call log_param(PF, mdl, "MAXIMUM_DEPTH", max_depth*US%Z_to_m, & "The maximum depth of the ocean.", units="m") else max_depth = diagnoseMaximumDepth(D,G) - call log_param(PF, mdl, "!MAXIMUM_DEPTH", max_depth*Z_to_m, & + call log_param(PF, mdl, "!MAXIMUM_DEPTH", max_depth*US%Z_to_m, & "The (diagnosed) maximum depth of the ocean.", units="m", like_default=.true.) endif if (trim(config) /= "DOME") then diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index f67a977d27..498e1915ba 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -58,19 +58,14 @@ module MOM_grid_initialize subroutine set_grid_metrics(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_L ! A length unit conversion factor [L m-1 ~> 1] - real :: L_to_m ! A length unit conversion factor [m L-1 ~> 1] ! This include declares and sets the variable "version". # include "version_variable.h" logical :: debug character(len=256) :: config - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m - call callTree_enter("set_grid_metrics(), MOM_grid_initialize.F90") call log_version(param_file, "MOM_grid_init", version, "") call get_param(param_file, "MOM_grid_init", "GRID_CONFIG", config, & @@ -88,7 +83,7 @@ subroutine set_grid_metrics(G, param_file, US) ! These are defaults that may be changed in the next select block. G%x_axis_units = "degrees_east" ; G%y_axis_units = "degrees_north" - G%Rad_Earth_L = -1.0*m_to_L ; G%len_lat = 0.0 ; G%len_lon = 0.0 + G%Rad_Earth_L = -1.0*US%m_to_L ; G%len_lat = 0.0 ; G%len_lon = 0.0 select case (trim(config)) case ("mosaic"); call set_grid_metrics_from_mosaic(G, param_file, US) case ("cartesian"); call set_grid_metrics_cartesian(G, param_file, US) @@ -104,11 +99,11 @@ subroutine set_grid_metrics(G, param_file, US) ! The grid metrics were set with an option that does not explicitly initialize Rad_Earth. ! ### Rad_Earth should be read as in: ! call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth_L, & - ! "The radius of the Earth.", units="m", default=6.378e6, scale=m_to_L) + ! "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) ! but for now it is being set via a hard-coded value to reproduce current behavior. - G%Rad_Earth_L = 6.378e6*m_to_L + G%Rad_Earth_L = 6.378e6*US%m_to_L endif - G%Rad_Earth = L_to_m*G%Rad_Earth_L + G%Rad_Earth = US%L_to_m*G%Rad_Earth_L ! Calculate derived metrics (i.e. reciprocals and products) call callTree_enter("set_derived_metrics(), MOM_grid_initialize.F90") @@ -127,39 +122,35 @@ end subroutine set_grid_metrics subroutine grid_metrics_chksum(parent, G, US) character(len=*), intent(in) :: parent !< A string identifying the caller type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] - real :: L_to_m ! A unit conversion factor [m L-1 ~> 1] integer :: halo - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m halo = min(G%ied-G%iec, G%jed-G%jec, 1) call hchksum_pair(trim(parent)//': d[xy]T', G%dxT, G%dyT, G%HI, & - haloshift=halo, scale=L_to_m, scalar_pair=.true.) + haloshift=halo, scale=US%L_to_m, scalar_pair=.true.) - call uvchksum(trim(parent)//': dxC[uv]', G%dxCu, G%dyCv, G%HI, haloshift=halo, scale=L_to_m) + call uvchksum(trim(parent)//': dxC[uv]', G%dxCu, G%dyCv, G%HI, haloshift=halo, scale=US%L_to_m) - call uvchksum(trim(parent)//': dxC[uv]', G%dyCu, G%dxCv, G%HI, haloshift=halo, scale=L_to_m) + call uvchksum(trim(parent)//': dxC[uv]', G%dyCu, G%dxCv, G%HI, haloshift=halo, scale=US%L_to_m) - call Bchksum_pair(trim(parent)//': dxB[uv]', G%dxBu, G%dyBu, G%HI, haloshift=halo, scale=L_to_m) + call Bchksum_pair(trim(parent)//': dxB[uv]', G%dxBu, G%dyBu, G%HI, haloshift=halo, scale=US%L_to_m) call hchksum_pair(trim(parent)//': Id[xy]T', G%IdxT, G%IdyT, G%HI, & - haloshift=halo, scale=m_to_L, scalar_pair=.true.) + haloshift=halo, scale=US%m_to_L, scalar_pair=.true.) - call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdxCu, G%IdyCv, G%HI, haloshift=halo, scale=m_to_L) + call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdxCu, G%IdyCv, G%HI, haloshift=halo, scale=US%m_to_L) - call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdyCu, G%IdxCv, G%HI, haloshift=halo, scale=m_to_L) + call uvchksum(trim(parent)//': Id[xy]C[uv]', G%IdyCu, G%IdxCv, G%HI, haloshift=halo, scale=US%m_to_L) - call Bchksum_pair(trim(parent)//': Id[xy]B[uv]', G%IdxBu, G%IdyBu, G%HI, haloshift=halo, scale=m_to_L) + call Bchksum_pair(trim(parent)//': Id[xy]B[uv]', G%IdxBu, G%IdyBu, G%HI, haloshift=halo, scale=US%m_to_L) - call hchksum(G%areaT, trim(parent)//': areaT',G%HI, haloshift=halo, scale=L_to_m**2) - call Bchksum(G%areaBu, trim(parent)//': areaBu',G%HI, haloshift=halo, scale=L_to_m**2) + call hchksum(G%areaT, trim(parent)//': areaT',G%HI, haloshift=halo, scale=US%L_to_m**2) + call Bchksum(G%areaBu, trim(parent)//': areaBu',G%HI, haloshift=halo, scale=US%L_to_m**2) - call hchksum(G%IareaT, trim(parent)//': IareaT',G%HI, haloshift=halo, scale=m_to_L**2) - call Bchksum(G%IareaBu, trim(parent)//': IareaBu',G%HI, haloshift=halo, scale=m_to_L**2) + call hchksum(G%IareaT, trim(parent)//': IareaT',G%HI, haloshift=halo, scale=US%m_to_L**2) + call Bchksum(G%IareaBu, trim(parent)//': IareaBu',G%HI, haloshift=halo, scale=US%m_to_L**2) call hchksum(G%geoLonT,trim(parent)//': geoLonT',G%HI, haloshift=halo) call hchksum(G%geoLatT,trim(parent)//': geoLatT',G%HI, haloshift=halo) @@ -178,8 +169,8 @@ end subroutine grid_metrics_chksum !> Sets the grid metrics from a mosaic file. subroutine set_grid_metrics_from_mosaic(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type - type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables real, dimension(G%isd :G%ied ,G%jsd :G%jed ) :: tempH1, tempH2, tempH3, tempH4 real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: tempQ1, tempQ2, tempQ3, tempQ4 @@ -197,7 +188,6 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) real, dimension(2*G%isd-2:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpV real, dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpZ real, dimension(:,:), allocatable :: tmpGlbl - real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] character(len=200) :: filename, grid_file, inputdir character(len=64) :: mdl = "MOM_grid_init set_grid_metrics_from_mosaic" type(MOM_domain_type), pointer :: SGdom => NULL() ! Supergrid domain @@ -207,7 +197,6 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) call callTree_enter("set_grid_metrics_from_mosaic(), MOM_grid_initialize.F90") - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L call get_param(param_file, mdl, "GRID_FILE", grid_file, & "Name of the file from which to read horizontal grid data.", & fail_if_missing=.true.) @@ -331,16 +320,16 @@ subroutine set_grid_metrics_from_mosaic(G, param_file, US) call pass_var(areaBu, G%Domain, position=CORNER) do i=G%isd,G%ied ; do j=G%jsd,G%jed - G%dxT(i,j) = m_to_L*dxT(i,j) ; G%dyT(i,j) = m_to_L*dyT(i,j) ; G%areaT(i,j) = m_to_L**2*areaT(i,j) + G%dxT(i,j) = US%m_to_L*dxT(i,j) ; G%dyT(i,j) = US%m_to_L*dyT(i,j) ; G%areaT(i,j) = US%m_to_L**2*areaT(i,j) enddo ; enddo do I=G%IsdB,G%IedB ; do j=G%jsd,G%jed - G%dxCu(I,j) = m_to_L*dxCu(I,j) ; G%dyCu(I,j) = m_to_L*dyCu(I,j) + G%dxCu(I,j) = US%m_to_L*dxCu(I,j) ; G%dyCu(I,j) = US%m_to_L*dyCu(I,j) enddo ; enddo do i=G%isd,G%ied ; do J=G%JsdB,G%JedB - G%dxCv(i,J) = m_to_L*dxCv(i,J) ; G%dyCv(i,J) = m_to_L*dyCv(i,J) + G%dxCv(i,J) = US%m_to_L*dxCv(i,J) ; G%dyCv(i,J) = US%m_to_L*dyCv(i,J) enddo ; enddo do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB - G%dxBu(I,J) = m_to_L*dxBu(I,J) ; G%dyBu(I,J) = m_to_L*dyBu(I,J) ; G%areaBu(I,J) = m_to_L**2*areaBu(I,J) + G%dxBu(I,J) = US%m_to_L*dxBu(I,J) ; G%dyBu(I,J) = US%m_to_L*dyBu(I,J) ; G%areaBu(I,J) = US%m_to_L**2*areaBu(I,J) enddo ; enddo ! Construct axes for diagnostic output (only necessary because "ferret" uses @@ -395,8 +384,8 @@ end subroutine set_grid_metrics_from_mosaic !! sets of points. subroutine set_grid_metrics_cartesian(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type - type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, I1off, J1off integer :: niglobal, njglobal @@ -405,7 +394,6 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) real :: dx_everywhere, dy_everywhere ! Grid spacings [L ~> m]. real :: I_dx, I_dy ! Inverse grid spacings [L-1 ~> m-1]. real :: PI - real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] character(len=80) :: units_temp character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_cartesian" @@ -416,7 +404,6 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) call callTree_enter("set_grid_metrics_cartesian(), MOM_grid_initialize.F90") - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L PI = 4.0*atan(1.0) call get_param(param_file, mdl, "AXIS_UNITS", units_temp, & @@ -438,7 +425,7 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) "The longitudinal or x-direction length of the domain.", & units=units_temp, fail_if_missing=.true.) call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth_L, & - "The radius of the Earth.", units="m", default=6.378e6, scale=m_to_L) + "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) if (units_temp(1:1) == 'k') then G%x_axis_units = "kilometers" ; G%y_axis_units = "kilometers" @@ -476,11 +463,11 @@ subroutine set_grid_metrics_cartesian(G, param_file, US) enddo if (units_temp(1:1) == 'k') then ! Axes are measured in km. - dx_everywhere = 1000.0*m_to_L * G%len_lon / (REAL(niglobal)) - dy_everywhere = 1000.0*m_to_L * G%len_lat / (REAL(njglobal)) + dx_everywhere = 1000.0*US%m_to_L * G%len_lon / (REAL(niglobal)) + dy_everywhere = 1000.0*US%m_to_L * G%len_lat / (REAL(njglobal)) elseif (units_temp(1:1) == 'm') then ! Axes are measured in m. - dx_everywhere = m_to_L*G%len_lon / (REAL(niglobal)) - dy_everywhere = m_to_L*G%len_lat / (REAL(njglobal)) + dx_everywhere = US%m_to_L*G%len_lon / (REAL(niglobal)) + dy_everywhere = US%m_to_L*G%len_lat / (REAL(njglobal)) else ! Axes are measured in degrees of latitude and longitude. dx_everywhere = G%Rad_Earth_L * G%len_lon * PI / (180.0 * niglobal) dy_everywhere = G%Rad_Earth_L * G%len_lat * PI / (180.0 * njglobal) @@ -531,8 +518,8 @@ end subroutine set_grid_metrics_cartesian !! sets of points. subroutine set_grid_metrics_spherical(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type - type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables real :: PI, PI_180! PI = 3.1415926... as 4*atan(1) integer :: i, j, isd, ied, jsd, jed @@ -541,7 +528,6 @@ subroutine set_grid_metrics_spherical(G, param_file, US) real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) real :: dLon,dLat,latitude,longitude,dL_di - real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_spherical" is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -551,7 +537,6 @@ subroutine set_grid_metrics_spherical(G, param_file, US) i_offset = G%idg_offset ; j_offset = G%jdg_offset call callTree_enter("set_grid_metrics_spherical(), MOM_grid_initialize.F90") - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L ! Calculate the values of the metric terms that might be used ! and save them in arrays. @@ -570,7 +555,7 @@ subroutine set_grid_metrics_spherical(G, param_file, US) "The longitudinal length of the domain.", units="degrees", & fail_if_missing=.true.) call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth_L, & - "The radius of the Earth.", units="m", default=6.378e6, scale=m_to_L) + "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) dLon = G%len_lon/G%Domain%niglobal dLat = G%len_lat/G%Domain%njglobal @@ -670,8 +655,8 @@ end subroutine set_grid_metrics_spherical !! sets of points. subroutine set_grid_metrics_mercator(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type - type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i, j, isd, ied, jsd, jed integer :: I_off, J_off @@ -691,7 +676,6 @@ subroutine set_grid_metrics_mercator(G, param_file, US) real :: fnRef ! fnRef is the value of Int_dj_dy or ! Int_dj_dy at a latitude or longitude that is real :: jRef, iRef ! being set to be at grid index jRef or iRef. - real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] integer :: itt1, itt2 logical :: debug = .FALSE., simple_area = .true. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, IsdB, IedB, JsdB, JedB @@ -710,7 +694,6 @@ subroutine set_grid_metrics_mercator(G, param_file, US) call callTree_enter("set_grid_metrics_mercator(), MOM_grid_initialize.F90") - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L ! Calculate the values of the metric terms that might be used ! and save them in arrays. PI = 4.0*atan(1.0) ; PI_2 = 0.5*PI @@ -728,7 +711,7 @@ subroutine set_grid_metrics_mercator(G, param_file, US) "The longitudinal length of the domain.", units="degrees", & fail_if_missing=.true.) call get_param(param_file, mdl, "RAD_EARTH", GP%Rad_Earth_L, & - "The radius of the Earth.", units="m", default=6.378e6, scale=m_to_L) + "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) G%south_lat = GP%south_lat ; G%len_lat = GP%len_lat G%west_lon = GP%west_lon ; G%len_lon = GP%len_lon G%Rad_Earth_L = GP%Rad_Earth_L @@ -1210,11 +1193,10 @@ end function Adcroft_reciprocal !! any land or boundary point. For points in the interior, mask2dCu, !! mask2dCv, and mask2dBu are all 1.0. subroutine initialize_masks(G, PF, US) - type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type - type(param_file_type), intent(in) :: PF !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type + type(param_file_type), intent(in) :: PF !< Parameter file structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z_scale ! A unit conversion factor from m to Z [Z m-1 ~> 1] real :: Dmask ! The depth for masking in the same units as G%bathyT [Z ~> m]. real :: min_depth ! The minimum ocean depth in the same units as G%bathyT [Z ~> m]. real :: mask_depth ! The depth shallower than which to mask a point as land [Z ~> m]. @@ -1222,22 +1204,21 @@ subroutine initialize_masks(G, PF, US) integer :: i, j call callTree_enter("initialize_masks(), MOM_grid_initialize.F90") - m_to_Z_scale = 1.0 ; if (present(US)) m_to_Z_scale = US%m_to_Z call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & "If MASKING_DEPTH is unspecified, then anything shallower than "//& "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out. "//& "If MASKING_DEPTH is specified, then all depths shallower than "//& "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", & - units="m", default=0.0, scale=m_to_Z_scale) + units="m", default=0.0, scale=US%m_to_Z) call get_param(PF, mdl, "MASKING_DEPTH", mask_depth, & "The depth below which to mask points as land points, for which all "//& "fluxes are zeroed out. MASKING_DEPTH is ignored if it has the special "//& "default value.", & - units="m", default=-9999.0, scale=m_to_Z_scale) + units="m", default=-9999.0, scale=US%m_to_Z) Dmask = mask_depth - if (mask_depth == -9999.*m_to_Z_scale) Dmask = min_depth + if (mask_depth == -9999.0*US%m_to_Z) Dmask = min_depth G%mask2dCu(:,:) = 0.0 ; G%mask2dCv(:,:) = 0.0 ; G%mask2dBu(:,:) = 0.0 diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 9973b64a21..bb5a84033b 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -57,7 +57,7 @@ subroutine MOM_initialize_rotation(f, G, PF, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), intent(out) :: f !< The Coriolis parameter [T-1 ~> s-1] type(param_file_type), intent(in) :: PF !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! This subroutine makes the appropriate call to set up the Coriolis parameter. ! This is a separate subroutine so that it can be made public and shared with @@ -95,11 +95,8 @@ subroutine MOM_calculate_grad_Coriolis(dF_dx, dF_dy, G, US) type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables integer :: i,j - real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] real :: f1, f2 - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - if ((LBOUND(G%CoriolisBu,1) > G%isc-1) .or. & (LBOUND(G%CoriolisBu,2) > G%isc-1)) then ! The gradient of the Coriolis parameter can not be calculated with this grid. @@ -139,19 +136,16 @@ end function diagnoseMaximumDepth subroutine initialize_topography_from_file(D, G, param_file, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. character(len=200) :: filename, topo_file, inputdir ! Strings for file/path character(len=200) :: topo_varname ! Variable name in file character(len=40) :: mdl = "initialize_topography_from_file" ! This subroutine's name. call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "TOPO_FILE", topo_file, & @@ -167,13 +161,13 @@ subroutine initialize_topography_from_file(D, G, param_file, US) if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_topography_from_file: Unable to open "//trim(filename)) - D(:,:) = -9.e30*m_to_Z ! Initializing to a very large negative depth (tall mountains) everywhere + D(:,:) = -9.0e30*US%m_to_Z ! Initializing to a very large negative depth (tall mountains) everywhere ! before reading from a file should do nothing. However, in the instance of ! masked-out PEs, halo regions are not updated when a processor does not ! exist. We need to ensure the depth in masked-out PEs appears to be that ! of land so this line does that in the halo regions. For non-masked PEs ! the halo region is filled properly with a later pass_var(). - call MOM_read_data(filename, trim(topo_varname), D, G%Domain, scale=m_to_Z) + call MOM_read_data(filename, trim(topo_varname), D, G%Domain, scale=US%m_to_Z) call apply_topography_edits_from_file(D, G, param_file, US) @@ -187,10 +181,9 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) intent(inout) :: D !< Ocean bottom depth [m] or [Z ~> m] if !! US is present type(param_file_type), intent(in) :: param_file !< Parameter file structure - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. real, dimension(:), allocatable :: new_depth ! The new values of the depths [m] integer, dimension(:), allocatable :: ig, jg ! The global indicies of the points to modify character(len=200) :: topo_edits_file, inputdir ! Strings for file/path @@ -202,8 +195,6 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "TOPO_EDITS_FILE", topo_edits_file, & @@ -217,13 +208,13 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out. "//& "If MASKING_DEPTH is specified, then all depths shallower than "//& "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", & - units="m", default=0.0, scale=m_to_Z) + units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "MASKING_DEPTH", mask_depth, & "The depth below which to mask points as land points, for which all "//& "fluxes are zeroed out. MASKING_DEPTH is ignored if it has the special "//& "default value.", & - units="m", default=-9999.0, scale=m_to_Z) - if (mask_depth == -9999.*m_to_Z) mask_depth = min_depth + units="m", default=-9999.0, scale=US%m_to_Z) + if (mask_depth == -9999.*US%m_to_Z) mask_depth = min_depth if (len_trim(topo_edits_file)==0) return @@ -263,15 +254,15 @@ subroutine apply_topography_edits_from_file(D, G, param_file, US) i = ig(n) - G%isd_global + 2 ! +1 for python indexing and +1 for ig-isd_global+1 j = jg(n) - G%jsd_global + 2 if (i>=G%isc .and. i<=G%iec .and. j>=G%jsc .and. j<=G%jec) then - if (new_depth(n)*m_to_Z /= mask_depth) then + if (new_depth(n)*US%m_to_Z /= mask_depth) then write(stdout,'(a,3i5,f8.2,a,f8.2,2i4)') & - 'Ocean topography edit: ', n, ig(n), jg(n), D(i,j)/m_to_Z, '->', abs(new_depth(n)), i, j - D(i,j) = abs(m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) + 'Ocean topography edit: ', n, ig(n), jg(n), D(i,j)*US%Z_to_m, '->', abs(new_depth(n)), i, j + D(i,j) = abs(US%m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) else if (topo_edits_change_mask) then write(stdout,'(a,3i5,f8.2,a,f8.2,2i4)') & - 'Ocean topography edit: ',n,ig(n),jg(n),D(i,j)/m_to_Z,'->',abs(new_depth(n)),i,j - D(i,j) = abs(m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) + 'Ocean topography edit: ',n,ig(n),jg(n),D(i,j)*US%Z_to_m,'->',abs(new_depth(n)),i,j + D(i,j) = abs(US%m_to_Z*new_depth(n)) ! Allows for height-file edits (i.e. converts negatives) else call MOM_error(FATAL, ' apply_topography_edits_from_file: '//& "A zero depth edit would change the land mask and is not allowed in"//trim(topo_edits_file)) @@ -289,18 +280,16 @@ end subroutine apply_topography_edits_from_file subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure character(len=*), intent(in) :: topog_config !< The name of an idealized !! topographic configuration - real, intent(in) :: max_depth !< Maximum depth of model in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! This subroutine places the bottom depth in m into D(:,:), shaped according to the named config. ! Local variables - real :: m_to_Z ! A dimensional rescaling factor [Z m-1 ~> 1] - real :: m_to_L ! A dimensional rescaling factor [L m-1 ~> 1] real :: min_depth ! The minimum depth [Z ~> m]. real :: PI ! 3.1415926... calculated as 4*atan(1) real :: D0 ! A constant to make the maximum basin depth MAXIMUM_DEPTH [Z ~> m] @@ -315,21 +304,18 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth call MOM_mesg(" MOM_shared_initialization.F90, initialize_topography_named: "//& "TOPO_CONFIG = "//trim(topog_config), 5) - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) + "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) if (max_depth<=0.) call MOM_error(FATAL,"initialize_topography_named: "// & "MAXIMUM_DEPTH has a non-sensical value! Was it set?") if (trim(topog_config) /= "flat") then call get_param(param_file, mdl, "EDGE_DEPTH", Dedge, & "The depth at the edge of one of the named topographies.", & - units="m", default=100.0, scale=m_to_Z) + units="m", default=100.0, scale=US%m_to_Z) call get_param(param_file, mdl, "TOPOG_SLOPE_SCALE", expdecay, & "The exponential decay scale used in defining some of "//& - "the named topographies.", units="m", default=400000.0, scale=m_to_L) + "the named topographies.", units="m", default=400000.0, scale=US%m_to_L) endif @@ -389,13 +375,12 @@ end subroutine initialize_topography_named subroutine limit_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(inout) :: D !< Ocean bottom depth in m or Z if US is present + intent(inout) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum depth of model in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum depth of model [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. integer :: i, j character(len=40) :: mdl = "limit_topography" ! This subroutine's name. real :: min_depth ! The shallowest value of wet points [Z ~> m] @@ -403,24 +388,22 @@ subroutine limit_topography(D, G, param_file, max_depth, US) call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "If MASKING_DEPTH is unspecified, then anything shallower than "//& "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out. "//& "If MASKING_DEPTH is specified, then all depths shallower than "//& "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", & - units="m", default=0.0, scale=m_to_Z) + units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "MASKING_DEPTH", mask_depth, & "The depth below which to mask points as land points, for which all "//& "fluxes are zeroed out. MASKING_DEPTH is ignored if it has the special "//& "default value.", & - units="m", default=-9999.0, scale=m_to_Z, do_not_log=.true.) + units="m", default=-9999.0, scale=US%m_to_Z, do_not_log=.true.) ! Make sure that min_depth < D(x,y) < max_depth for ocean points ! TBD: The following f.p. equivalence uses a special value. Originally, any negative value ! indicated the branch. We should create a logical flag to indicate this branch. - if (mask_depth == -9999.*m_to_Z) then + if (mask_depth == -9999.*US%m_to_Z) then if (min_depth<0.) then call MOM_error(FATAL, trim(mdl)//": MINIMUM_DEPTH<0 does not work as expected "//& "unless MASKING_DEPTH has been set appropriately. Set a meaningful "//& @@ -460,22 +443,19 @@ subroutine set_rotation_planetary(f, G, param_file, US) real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & intent(out) :: f !< Coriolis parameter (vertical component) [T-1 ~> s-1] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! This subroutine sets up the Coriolis parameter for a sphere character(len=30) :: mdl = "set_rotation_planetary" ! This subroutine's name. integer :: I, J real :: PI real :: omega ! The planetary rotation rate [T-1 ~> s-1] - real :: T_to_s ! A time unit conversion factor call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - T_to_s = 1.0 ; if (present(US)) T_to_s = US%T_to_s - call get_param(param_file, "set_rotation_planetary", "OMEGA", omega, & "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5, scale=T_to_s) + default=7.2921e-5, scale=US%T_to_s) PI = 4.0*atan(1.0) do I=G%IsdB,G%IedB ; do J=G%JsdB,G%JedB @@ -493,7 +473,7 @@ subroutine set_rotation_beta_plane(f, G, param_file, US) real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & intent(out) :: f !< Coriolis parameter (vertical component) [T-1 ~> s-1] type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! This subroutine sets up the Coriolis parameter for a beta-plane integer :: I, J @@ -502,9 +482,6 @@ subroutine set_rotation_beta_plane(f, G, param_file, US) real :: beta_lat_ref ! The reference latitude for the beta plane [degrees/km/m/cm] real :: Rad_Earth_L ! The radius of the planet in rescaled units [L ~> m] real :: y_scl ! A scaling factor from the units of latitude [L lat-1 ~> m lat-1] - real :: T_to_s ! A time unit conversion factor [s T-1 ~> 1] - real :: m_to_L ! A length unit conversion factor [L m-1 ~> 1] - real :: L_to_m ! A length unit conversion factor [m L-1 ~> 1] real :: PI character(len=40) :: mdl = "set_rotation_beta_plane" ! This subroutine's name. character(len=200) :: axis_units @@ -512,31 +489,27 @@ subroutine set_rotation_beta_plane(f, G, param_file, US) call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - T_to_s = 1.0 ; if (present(US)) T_to_s = US%T_to_s - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m - call get_param(param_file, mdl, "F_0", f_0, & "The reference value of the Coriolis parameter with the "//& - "betaplane option.", units="s-1", default=0.0, scale=T_to_s) + "betaplane option.", units="s-1", default=0.0, scale=US%T_to_s) call get_param(param_file, mdl, "BETA", beta, & "The northward gradient of the Coriolis parameter with "//& - "the betaplane option.", units="m-1 s-1", default=0.0, scale=T_to_s*L_to_m) + "the betaplane option.", units="m-1 s-1", default=0.0, scale=US%T_to_s*US%L_to_m) call get_param(param_file, mdl, "AXIS_UNITS", axis_units, default="degrees") PI = 4.0*atan(1.0) select case (axis_units(1:1)) case ("d") call get_param(param_file, mdl, "RAD_EARTH", Rad_Earth_L, & - "The radius of the Earth.", units="m", default=6.378e6, scale=m_to_L) + "The radius of the Earth.", units="m", default=6.378e6, scale=US%m_to_L) beta_lat_ref_units = "degrees" y_scl = PI * Rad_Earth_L / 180. case ("k") beta_lat_ref_units = "kilometers" - y_scl = 1.E3 * m_to_L + y_scl = 1.0e3 * US%m_to_L case ("m") beta_lat_ref_units = "meters" - y_scl = 1. * m_to_L + y_scl = 1.0 * US%m_to_L case default ; call MOM_error(FATAL, & " set_rotation_beta_plane: unknown AXIS_UNITS = "//trim(axis_units)) end select @@ -633,90 +606,89 @@ subroutine reset_face_lengths_named(G, param_file, name, US) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters character(len=*), intent(in) :: name !< The name for the set of face lengths. Only "global_1deg" !! is currently implemented. - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables character(len=256) :: mesg ! Message for error messages. - real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] - real :: L_to_m ! A unit conversion factor [m L-1 ~> 1] - real :: dx_2 = -1.0, dy_2 = -1.0 + real :: dx_2 ! Half the local zonal grid spacing [degreesE] + real :: dy_2 ! Half the local meridional grid spacing [degreesN] real :: pi_180 - integer :: option = -1 + integer :: option integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB pi_180 = (4.0*atan(1.0))/180.0 + dx_2 = -1.0 ; dy_2 = -1.0 + option = -1 + select case ( trim(name) ) case ("global_1deg") ; option = 1 ; dx_2 = 0.5*1.0 case default ; call MOM_error(FATAL, "reset_face_lengths_named: "//& "Unrecognized channel configuration name "//trim(name)) end select - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m - if (option==1) then ! 1-degree settings. do j=jsd,jed ; do I=IsdB,IedB ! Change any u-face lengths within this loop. dy_2 = dx_2 * G%dyCu(I,j)*G%IdxCu(I,j) * cos(pi_180 * G%geoLatCu(I,j)) if ((abs(G%geoLatCu(I,j)-35.5) < dy_2) .and. (G%geoLonCu(I,j) < -4.5) .and. & (G%geoLonCu(I,j) > -6.5)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*12000.0*m_to_L ! Gibraltar + G%dy_Cu(I,j) = G%mask2dCu(I,j)*12000.0*US%m_to_L ! Gibraltar if ((abs(G%geoLatCu(I,j)-12.5) < dy_2) .and. (abs(G%geoLonCu(I,j)-43.0) < dx_2)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*10000.0*m_to_L ! Red Sea + G%dy_Cu(I,j) = G%mask2dCu(I,j)*10000.0*US%m_to_L ! Red Sea if ((abs(G%geoLatCu(I,j)-40.5) < dy_2) .and. (abs(G%geoLonCu(I,j)-26.0) < dx_2)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*5000.0*m_to_L ! Dardanelles + G%dy_Cu(I,j) = G%mask2dCu(I,j)*5000.0*US%m_to_L ! Dardanelles if ((abs(G%geoLatCu(I,j)-41.5) < dy_2) .and. (abs(G%geoLonCu(I,j)+220.0) < dx_2)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*35000.0*m_to_L ! Tsugaru strait at 140.0e + G%dy_Cu(I,j) = G%mask2dCu(I,j)*35000.0*US%m_to_L ! Tsugaru strait at 140.0e if ((abs(G%geoLatCu(I,j)-45.5) < dy_2) .and. (abs(G%geoLonCu(I,j)+217.5) < 0.9)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*15000.0*m_to_L ! Betw Hokkaido and Sakhalin at 217&218 = 142e + G%dy_Cu(I,j) = G%mask2dCu(I,j)*15000.0*US%m_to_L ! Betw Hokkaido and Sakhalin at 217&218 = 142e ! Greater care needs to be taken in the tripolar region. if ((abs(G%geoLatCu(I,j)-80.84) < 0.2) .and. (abs(G%geoLonCu(I,j)+64.9) < 0.8)) & - G%dy_Cu(I,j) = G%mask2dCu(I,j)*38000.0*m_to_L ! Smith Sound in Canadian Arch - tripolar region + G%dy_Cu(I,j) = G%mask2dCu(I,j)*38000.0*US%m_to_L ! Smith Sound in Canadian Arch - tripolar region enddo ; enddo do J=JsdB,JedB ; do i=isd,ied ! Change any v-face lengths within this loop. dy_2 = dx_2 * G%dyCv(i,J)*G%IdxCv(i,J) * cos(pi_180 * G%geoLatCv(i,J)) if ((abs(G%geoLatCv(i,J)-41.0) < dy_2) .and. (abs(G%geoLonCv(i,J)-28.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*m_to_L ! Bosporus - should be 1000.0 m wide. + G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*US%m_to_L ! Bosporus - should be 1000.0 m wide. if ((abs(G%geoLatCv(i,J)-13.0) < dy_2) .and. (abs(G%geoLonCv(i,J)-42.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*10000.0*m_to_L ! Red Sea + G%dx_Cv(i,J) = G%mask2dCv(i,J)*10000.0*US%m_to_L ! Red Sea if ((abs(G%geoLatCv(i,J)+2.8) < 0.8) .and. (abs(G%geoLonCv(i,J)+241.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*40000.0*m_to_L ! Makassar Straits at 241.5 W = 118.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*40000.0*US%m_to_L ! Makassar Straits at 241.5 W = 118.5 E if ((abs(G%geoLatCv(i,J)-0.56) < 0.5) .and. (abs(G%geoLonCv(i,J)+240.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*80000.0*m_to_L ! entry to Makassar Straits at 240.5 W = 119.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*80000.0*US%m_to_L ! entry to Makassar Straits at 240.5 W = 119.5 E if ((abs(G%geoLatCv(i,J)-0.19) < 0.5) .and. (abs(G%geoLonCv(i,J)+230.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*m_to_L ! Channel betw N Guinea and Halmahara 230.5 W = 129.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*US%m_to_L ! Channel betw N Guinea and Halmahara 230.5 W = 129.5 E if ((abs(G%geoLatCv(i,J)-0.19) < 0.5) .and. (abs(G%geoLonCv(i,J)+229.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*m_to_L ! Channel betw N Guinea and Halmahara 229.5 W = 130.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*US%m_to_L ! Channel betw N Guinea and Halmahara 229.5 W = 130.5 E if ((abs(G%geoLatCv(i,J)-0.0) < 0.25) .and. (abs(G%geoLonCv(i,J)+228.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*m_to_L ! Channel betw N Guinea and Halmahara 228.5 W = 131.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*25000.0*US%m_to_L ! Channel betw N Guinea and Halmahara 228.5 W = 131.5 E if ((abs(G%geoLatCv(i,J)+8.5) < 0.5) .and. (abs(G%geoLonCv(i,J)+244.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*m_to_L ! Lombok Straits at 244.5 W = 115.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*US%m_to_L ! Lombok Straits at 244.5 W = 115.5 E if ((abs(G%geoLatCv(i,J)+8.5) < 0.5) .and. (abs(G%geoLonCv(i,J)+235.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*m_to_L ! Timor Straits at 235.5 W = 124.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*20000.0*US%m_to_L ! Timor Straits at 235.5 W = 124.5 E if ((abs(G%geoLatCv(i,J)-52.5) < dy_2) .and. (abs(G%geoLonCv(i,J)+218.5) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*m_to_L ! Russia and Sakhalin Straits at 218.5 W = 141.5 E + G%dx_Cv(i,J) = G%mask2dCv(i,J)*2500.0*US%m_to_L ! Russia and Sakhalin Straits at 218.5 W = 141.5 E ! Greater care needs to be taken in the tripolar region. if ((abs(G%geoLatCv(i,J)-76.8) < 0.06) .and. (abs(G%geoLonCv(i,J)+88.7) < dx_2)) & - G%dx_Cv(i,J) = G%mask2dCv(i,J)*8400.0*m_to_L ! Jones Sound in Canadian Arch - tripolar region + G%dx_Cv(i,J) = G%mask2dCv(i,J)*8400.0*US%m_to_L ! Jones Sound in Canadian Arch - tripolar region enddo ; enddo endif @@ -724,10 +696,10 @@ subroutine reset_face_lengths_named(G, param_file, name, US) ! These checks apply regardless of the chosen option. do j=jsd,jed ; do I=IsdB,IedB - if (L_to_m*G%dy_Cu(I,j) > L_to_m*G%dyCu(I,j)) then + if (G%dy_Cu(I,j) > G%dyCu(I,j)) then write(mesg,'("dy_Cu of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4," at lon/lat of ", ES11.4, ES11.4)') & - L_to_m*G%dy_Cu(I,j), L_to_m*G%dyCu(I,j), L_to_m*G%dy_Cu(I,j)-L_to_m*G%dyCu(I,j), & + US%L_to_m*G%dy_Cu(I,j), US%L_to_m*G%dyCu(I,j), US%L_to_m*(G%dy_Cu(I,j)-G%dyCu(I,j)), & G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) endif @@ -737,10 +709,10 @@ subroutine reset_face_lengths_named(G, param_file, name, US) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied - if (L_to_m*G%dx_Cv(i,J) > L_to_m*G%dxCv(i,J)) then + if (G%dx_Cv(i,J) > G%dxCv(i,J)) then write(mesg,'("dx_Cv of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4, " at lon/lat of ", ES11.4, ES11.4)') & - L_to_m*G%dx_Cv(i,J), L_to_m*G%dxCv(i,J), L_to_m*G%dx_Cv(i,J)-L_to_m*G%dxCv(i,J), & + US%L_to_m*G%dx_Cv(i,J), US%L_to_m*G%dxCv(i,J), US%L_to_m*(G%dx_Cv(i,J)-G%dxCv(i,J)), & G%geoLonCv(i,J), G%geoLatCv(i,J) call MOM_error(FATAL,"reset_face_lengths_named "//mesg) @@ -759,22 +731,18 @@ end subroutine reset_face_lengths_named subroutine reset_face_lengths_file(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables character(len=40) :: mdl = "reset_face_lengths_file" ! This subroutine's name. character(len=256) :: mesg ! Message for error messages. character(len=200) :: filename, chan_file, inputdir ! Strings for file/path - real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] - real :: L_to_m ! A unit conversion factor [m L-1 ~> 1] integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! These checks apply regardless of the chosen option. call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m call get_param(param_file, mdl, "CHANNEL_WIDTH_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & @@ -789,14 +757,14 @@ subroutine reset_face_lengths_file(G, param_file, US) trim(filename)) endif - call MOM_read_vector(filename, "dyCuo", "dxCvo", G%dy_Cu, G%dx_Cv, G%Domain, scale=m_to_L) + call MOM_read_vector(filename, "dyCuo", "dxCvo", G%dy_Cu, G%dx_Cv, G%Domain, scale=US%m_to_L) call pass_vector(G%dy_Cu, G%dx_Cv, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) do j=jsd,jed ; do I=IsdB,IedB - if (L_to_m*G%dy_Cu(I,j) > L_to_m*G%dyCu(I,j)) then + if (G%dy_Cu(I,j) > G%dyCu(I,j)) then write(mesg,'("dy_Cu of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4," at lon/lat of ", ES11.4, ES11.4)') & - L_to_m*G%dy_Cu(I,j), L_to_m*G%dyCu(I,j), L_to_m*G%dy_Cu(I,j)-L_to_m*G%dyCu(I,j), & + US%L_to_m*G%dy_Cu(I,j), US%L_to_m*G%dyCu(I,j), US%L_to_m*(G%dy_Cu(I,j)-G%dyCu(I,j)), & G%geoLonCu(I,j), G%geoLatCu(I,j) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) endif @@ -806,10 +774,10 @@ subroutine reset_face_lengths_file(G, param_file, US) enddo ; enddo do J=JsdB,JedB ; do i=isd,ied - if (L_to_m*G%dx_Cv(i,J) > L_to_m*G%dxCv(i,J)) then + if (G%dx_Cv(i,J) > G%dxCv(i,J)) then write(mesg,'("dx_Cv of ",ES11.4," exceeds unrestricted width of ",ES11.4,& &" by ",ES11.4, " at lon/lat of ", ES11.4, ES11.4)') & - L_to_m*G%dx_Cv(i,J), L_to_m*G%dxCv(i,J), L_to_m*G%dx_Cv(i,J)-L_to_m*G%dxCv(i,J), & + US%L_to_m*G%dx_Cv(i,J), US%L_to_m*G%dxCv(i,J), US%L_to_m*(G%dx_Cv(i,J)-G%dxCv(i,J)), & G%geoLonCv(i,J), G%geoLatCv(i,J) call MOM_error(FATAL,"reset_face_lengths_file "//mesg) @@ -829,7 +797,7 @@ end subroutine reset_face_lengths_file subroutine reset_face_lengths_list(G, param_file, US) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables character(len=120), pointer, dimension(:) :: lines => NULL() @@ -847,9 +815,6 @@ subroutine reset_face_lengths_list(G, param_file, US) Dmin_u, Dmax_u, Davg_u ! Porous barrier monomial fit params [m] real, allocatable, dimension(:) :: & Dmin_v, Dmax_v, Davg_v - real :: m_to_L ! A unit conversion factor [L m-1 ~> 1] - real :: L_to_m ! A unit conversion factor [m L-1 ~> 1] - real :: m_to_Z ! A unit conversion factor [Z m-1 ~> 1] real :: lat, lon ! The latitude and longitude of a point. real :: len_lon ! The periodic range of longitudes, usually 360 degrees. real :: len_lat ! The range of latitudes, usually 180 degrees. @@ -870,9 +835,6 @@ subroutine reset_face_lengths_list(G, param_file, US) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - m_to_L = 1.0 ; if (present(US)) m_to_L = US%m_to_L - L_to_m = 1.0 ; if (present(US)) L_to_m = US%L_to_m - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z call get_param(param_file, mdl, "CHANNEL_LIST_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & @@ -1053,10 +1015,10 @@ subroutine reset_face_lengths_list(G, param_file, US) ((lon_p >= u_lon(1,npt)) .and. (lon_p <= u_lon(2,npt))) .or. & ((lon_m >= u_lon(1,npt)) .and. (lon_m <= u_lon(2,npt)))) ) then - G%dy_Cu(I,j) = G%mask2dCu(I,j) * min(G%dyCu(I,j), max(m_to_L*u_width(npt), 0.0)) - G%porous_DminU(I,j) = m_to_Z*Dmin_u(npt) - G%porous_DmaxU(I,j) = m_to_Z*Dmax_u(npt) - G%porous_DavgU(I,j) = m_to_Z*Davg_u(npt) + G%dy_Cu(I,j) = G%mask2dCu(I,j) * min(G%dyCu(I,j), max(US%m_to_L*u_width(npt), 0.0)) + G%porous_DminU(I,j) = US%m_to_Z*Dmin_u(npt) + G%porous_DmaxU(I,j) = US%m_to_Z*Dmax_u(npt) + G%porous_DavgU(I,j) = US%m_to_Z*Davg_u(npt) if (j>=G%jsc .and. j<=G%jec .and. I>=G%isc .and. I<=G%iec) then ! Limit messages/checking to compute domain if ( G%mask2dCu(I,j) == 0.0 ) then @@ -1066,7 +1028,7 @@ subroutine reset_face_lengths_list(G, param_file, US) u_line_used(npt) = u_line_used(npt) + 1 write(stdout,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') & "read_face_lengths_list : Modifying dy_Cu gridpoint at ",lat,lon," (",& - u_lat(1,npt), u_lat(2,npt), u_lon(1,npt), u_lon(2,npt),") to ",L_to_m*G%dy_Cu(I,j),"m" + u_lat(1,npt), u_lat(2,npt), u_lon(1,npt), u_lon(2,npt),") to ",US%L_to_m*G%dy_Cu(I,j),"m" write(stdout,'(A,3F8.2,A)') & "read_face_lengths_list : Porous Topography parameters: Dmin, Dmax, Davg (",G%porous_DminU(I,j),& G%porous_DmaxU(I,j), G%porous_DavgU(I,j),")m" @@ -1090,10 +1052,10 @@ subroutine reset_face_lengths_list(G, param_file, US) (((lon >= v_lon(1,npt)) .and. (lon <= v_lon(2,npt))) .or. & ((lon_p >= v_lon(1,npt)) .and. (lon_p <= v_lon(2,npt))) .or. & ((lon_m >= v_lon(1,npt)) .and. (lon_m <= v_lon(2,npt)))) ) then - G%dx_Cv(i,J) = G%mask2dCv(i,J) * min(G%dxCv(i,J), max(m_to_L*v_width(npt), 0.0)) - G%porous_DminV(i,J) = m_to_Z*Dmin_v(npt) - G%porous_DmaxV(i,J) = m_to_Z*Dmax_v(npt) - G%porous_DavgV(i,J) = m_to_Z*Davg_v(npt) + G%dx_Cv(i,J) = G%mask2dCv(i,J) * min(G%dxCv(i,J), max(US%m_to_L*v_width(npt), 0.0)) + G%porous_DminV(i,J) = US%m_to_Z*Dmin_v(npt) + G%porous_DmaxV(i,J) = US%m_to_Z*Dmax_v(npt) + G%porous_DavgV(i,J) = US%m_to_Z*Davg_v(npt) if (i>=G%isc .and. i<=G%iec .and. J>=G%jsc .and. J<=G%jec) then ! Limit messages/checking to compute domain if ( G%mask2dCv(i,J) == 0.0 ) then @@ -1103,7 +1065,7 @@ subroutine reset_face_lengths_list(G, param_file, US) v_line_used(npt) = v_line_used(npt) + 1 write(stdout,'(A,2F8.2,A,4F8.2,A5,F9.2,A1)') & "read_face_lengths_list : Modifying dx_Cv gridpoint at ",lat,lon," (",& - v_lat(1,npt), v_lat(2,npt), v_lon(1,npt), v_lon(2,npt),") to ",L_to_m*G%dx_Cv(I,j),"m" + v_lat(1,npt), v_lat(2,npt), v_lon(1,npt), v_lon(2,npt),") to ",US%L_to_m*G%dx_Cv(I,j),"m" write(stdout,'(A,3F8.2,A)') & "read_face_lengths_list : Porous Topography parameters: Dmin, Dmax, Davg (",G%porous_DminV(i,J),& G%porous_DmaxV(i,J), G%porous_DavgV(i,J),")m" @@ -1247,15 +1209,15 @@ end subroutine set_velocity_depth_min !> Pre-compute global integrals of grid quantities (like masked ocean area) for !! later use in reporting diagnostics subroutine compute_global_grid_integrals(G, US) - type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables real, dimension(G%isc:G%iec, G%jsc:G%jec) :: tmpForSumming - real :: area_scale ! A scaling factor for area into MKS units + real :: area_scale ! A scaling factor for area into MKS units [m2 L-2 ~> 1] integer :: i,j - area_scale = 1.0 ; if (present(US)) area_scale = US%L_to_m**2 + area_scale = US%L_to_m**2 tmpForSumming(:,:) = 0. G%areaT_global = 0.0 ; G%IareaT_global = 0.0 @@ -1275,13 +1237,13 @@ end subroutine compute_global_grid_integrals ! ----------------------------------------------------------------------------- !> Write out a file describing the topography, Coriolis parameter, grid locations !! and various other fixed fields from the grid. -subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) +subroutine write_ocean_geometry_file(G, param_file, directory, US, geom_file) type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type(param_file_type), intent(in) :: param_file !< Parameter file structure character(len=*), intent(in) :: directory !< The directory into which to place the geometry file. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=*), optional, intent(in) :: geom_file !< If present, the name of the geometry file !! (otherwise the file is "ocean_geometry") - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type ! Local variables. character(len=240) :: filepath ! The full path to the file to write @@ -1290,9 +1252,6 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) vars ! Types with metadata about the variables and their staggering type(fieldtype), dimension(:), allocatable :: & fields ! Opaque types used by MOM_io to store variable metadata information - real :: Z_to_m_scale ! A unit conversion factor from Z to m - real :: s_to_T_scale ! A unit conversion factor from T-1 to s-1 - real :: L_to_m_scale ! A unit conversion factor from L to m type(file_type) :: IO_handle ! The I/O handle of the fileset integer :: nFlds ! The number of variables in this file integer :: file_threading @@ -1300,11 +1259,6 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) call callTree_enter('write_ocean_geometry_file()') - Z_to_m_scale = 1.0 ; if (present(US)) Z_to_m_scale = US%Z_to_m - s_to_T_scale = 1.0 ; if (present(US)) s_to_T_scale = US%s_to_T - L_to_m_scale = 1.0 ; if (present(US)) L_to_m_scale = US%L_to_m - - nFlds = 19 ; if (G%bathymetry_at_vel) nFlds = 23 allocate(vars(nFlds)) @@ -1369,30 +1323,30 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file, US) call MOM_write_field(IO_handle, fields(3), G%Domain, G%geoLatT) call MOM_write_field(IO_handle, fields(4), G%Domain, G%geoLonT) - call MOM_write_field(IO_handle, fields(5), G%Domain, G%bathyT, scale=Z_to_m_scale) - call MOM_write_field(IO_handle, fields(6), G%Domain, G%CoriolisBu, scale=s_to_T_scale) + call MOM_write_field(IO_handle, fields(5), G%Domain, G%bathyT, scale=US%Z_to_m) + call MOM_write_field(IO_handle, fields(6), G%Domain, G%CoriolisBu, scale=US%s_to_T) - call MOM_write_field(IO_handle, fields(7), G%Domain, G%dxCv, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(8), G%Domain, G%dyCu, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(9), G%Domain, G%dxCu, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(10), G%Domain, G%dyCv, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(11), G%Domain, G%dxT, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(12), G%Domain, G%dyT, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(13), G%Domain, G%dxBu, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(14), G%Domain, G%dyBu, scale=L_to_m_scale) + call MOM_write_field(IO_handle, fields(7), G%Domain, G%dxCv, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(8), G%Domain, G%dyCu, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(9), G%Domain, G%dxCu, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(10), G%Domain, G%dyCv, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(11), G%Domain, G%dxT, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(12), G%Domain, G%dyT, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(13), G%Domain, G%dxBu, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(14), G%Domain, G%dyBu, scale=US%L_to_m) - call MOM_write_field(IO_handle, fields(15), G%Domain, G%areaT, scale=L_to_m_scale**2) - call MOM_write_field(IO_handle, fields(16), G%Domain, G%areaBu, scale=L_to_m_scale**2) + call MOM_write_field(IO_handle, fields(15), G%Domain, G%areaT, scale=US%L_to_m**2) + call MOM_write_field(IO_handle, fields(16), G%Domain, G%areaBu, scale=US%L_to_m**2) - call MOM_write_field(IO_handle, fields(17), G%Domain, G%dx_Cv, scale=L_to_m_scale) - call MOM_write_field(IO_handle, fields(18), G%Domain, G%dy_Cu, scale=L_to_m_scale) + call MOM_write_field(IO_handle, fields(17), G%Domain, G%dx_Cv, scale=US%L_to_m) + call MOM_write_field(IO_handle, fields(18), G%Domain, G%dy_Cu, scale=US%L_to_m) call MOM_write_field(IO_handle, fields(19), G%Domain, G%mask2dT) if (G%bathymetry_at_vel) then - call MOM_write_field(IO_handle, fields(20), G%Domain, G%Dblock_u, scale=Z_to_m_scale) - call MOM_write_field(IO_handle, fields(21), G%Domain, G%Dopen_u, scale=Z_to_m_scale) - call MOM_write_field(IO_handle, fields(22), G%Domain, G%Dblock_v, scale=Z_to_m_scale) - call MOM_write_field(IO_handle, fields(23), G%Domain, G%Dopen_v, scale=Z_to_m_scale) + call MOM_write_field(IO_handle, fields(20), G%Domain, G%Dblock_u, scale=US%Z_to_m) + call MOM_write_field(IO_handle, fields(21), G%Domain, G%Dopen_u, scale=US%Z_to_m) + call MOM_write_field(IO_handle, fields(22), G%Domain, G%Dblock_v, scale=US%Z_to_m) + call MOM_write_field(IO_handle, fields(23), G%Domain, G%Dopen_v, scale=US%Z_to_m) endif call close_file(IO_handle) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index ce1f9ad92f..2aab378b4a 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -742,7 +742,7 @@ end subroutine initialize_thickness_from_file !> Adjust interface heights to fit the bathymetry and diagnose layer thickness. !! !! If the bottom most interface is below the topography then the bottom-most -!! layers are contracted to GV%Angstrom_m. +!! layers are contracted to ANGSTROM thickness (which may be 0). !! If the bottom most interface is above the topography then the entire column !! is dilated (expanded) to fill the void. !! @remark{There is a (hard-wired) "tolerance" parameter such that the diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 23ef41be94..248bf6c0f0 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -40,13 +40,12 @@ module DOME_initialization subroutine DOME_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in [m] or [Z ~> m] if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth [m] or [Z ~> m] - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. real :: min_depth ! The minimum and maximum depths [Z ~> m]. ! This include declares and sets the variable "version". # include "version_variable.h" @@ -57,22 +56,20 @@ subroutine DOME_initialize_topography(D, G, param_file, max_depth, US) call MOM_mesg(" DOME_initialization.F90, DOME_initialize_topography: setting topography", 5) - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) + "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) do j=js,je ; do i=is,ie if (G%geoLatT(i,j) < 600.0) then if (G%geoLatT(i,j) < 300.0) then D(i,j) = max_depth else - D(i,j) = max_depth - 10.0*m_to_Z * (G%geoLatT(i,j)-300.0) + D(i,j) = max_depth - 10.0*US%m_to_Z * (G%geoLatT(i,j)-300.0) endif else if ((G%geoLonT(i,j) > 1000.0) .AND. (G%geoLonT(i,j) < 1100.0)) then - D(i,j) = 600.0*m_to_Z + D(i,j) = 600.0*US%m_to_Z else D(i,j) = 0.5*min_depth endif diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 617ac0da3d..2ebac05a68 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -42,14 +42,13 @@ module ISOMIP_initialization subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [m ~> Z] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [m ~> Z] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables real :: min_depth ! The minimum and maximum depths [Z ~> m]. - real :: m_to_Z ! A dimensional rescaling factor. ! The following variables are used to set up the bathymetry in the ISOMIP example. real :: bmax ! max depth of bedrock topography [Z ~> m] real :: b0,b2,b4,b6 ! first, second, third and fourth bedrock topography coeffs [Z ~> m] @@ -70,16 +69,14 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) call MOM_mesg(" ISOMIP_initialization.F90, ISOMIP_initialize_topography: setting topography", 5) - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) + "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "ISOMIP_2D",is_2D,'If true, use a 2D setup.', default=.false.) ! The following variables should be transformed into runtime parameters? - bmax = 720.0*m_to_Z ; dc = 500.0*m_to_Z - b0 = -150.0*m_to_Z ; b2 = -728.8*m_to_Z ; b4 = 343.91*m_to_Z ; b6 = -50.57*m_to_Z + bmax = 720.0*US%m_to_Z ; dc = 500.0*US%m_to_Z + b0 = -150.0*US%m_to_Z ; b2 = -728.8*US%m_to_Z ; b4 = 343.91*US%m_to_Z ; b6 = -50.57*US%m_to_Z xbar = 300.0e3 ; fc = 4.0e3 ; wc = 24.0e3 ; ly = 80.0e3 bx = 0.0 ; by = 0.0 ; xtil = 0.0 diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 9bdf9b45c3..4c0c55f746 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -119,14 +119,13 @@ end subroutine Kelvin_OBC_end subroutine Kelvin_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [m ~> Z] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D [Z ~> m or m] - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables character(len=40) :: mdl = "Kelvin_initialize_topography" ! This subroutine's name. - real :: m_to_Z ! A dimensional rescaling factor. real :: min_depth ! The minimum and maximum depths [Z ~> m]. real :: PI ! 3.1415... real :: coast_offset1, coast_offset2, coast_angle, right_angle @@ -134,10 +133,8 @@ subroutine Kelvin_initialize_topography(D, G, param_file, max_depth, US) call MOM_mesg(" Kelvin_initialization.F90, Kelvin_initialize_topography: setting topography", 5) - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) + "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "ROTATED_COAST_OFFSET_1", coast_offset1, & default=100.0, do_not_log=.true.) call get_param(param_file, mdl, "ROTATED_COAST_OFFSET_2", coast_offset2, & diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index ed7bc07ba3..110a12c5f5 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -325,13 +325,12 @@ end function sech subroutine Phillips_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [m ~> Z] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. real :: PI, Htop, Wtop, Ltop, offset, dist real :: x1, x2, x3, x4, y1, y2 integer :: i,j,is,ie,js,je @@ -340,10 +339,9 @@ subroutine Phillips_initialize_topography(D, G, param_file, max_depth, US) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec PI = 4.0*atan(1.0) - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z call get_param(param_file, mdl, "PHILLIPS_HTOP", Htop, & - "The maximum height of the topography.", units="m", scale=m_to_Z, & + "The maximum height of the topography.", units="m", scale=US%m_to_Z, & fail_if_missing=.true.) ! Htop=0.375*max_depth ! max height of topog. above max_depth Wtop = 0.5*G%len_lat ! meridional width of drake and mount diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index b955f75a32..7b46295c20 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -34,17 +34,16 @@ module benchmark_initialization subroutine benchmark_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or [Z ~> m] if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: min_depth ! The minimum and maximum depths [Z ~> m]. + real :: min_depth ! The minimum depth [Z ~> m] real :: PI ! 3.1415926... calculated as 4*atan(1) real :: D0 ! A constant to make the maximum ! ! basin depth MAXIMUM_DEPTH. ! - real :: m_to_Z ! A dimensional rescaling factor. real :: x, y ! This include declares and sets the variable "version". # include "version_variable.h" @@ -55,11 +54,9 @@ subroutine benchmark_initialize_topography(D, G, param_file, max_depth, US) call MOM_mesg(" benchmark_initialization.F90, benchmark_initialize_topography: setting topography", 5) - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & - "The minimum depth of the ocean.", units="m", default=0.0, scale=m_to_Z) + "The minimum depth of the ocean.", units="m", default=0.0, scale=US%m_to_Z) PI = 4.0*atan(1.0) D0 = max_depth / 0.5 diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index 041d77d9f9..2c84a6040c 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -28,8 +28,8 @@ module shelfwave_initialization !> Control structure for shelfwave open boundaries. type, public :: shelfwave_OBC_CS ; private - real :: Lx = 100.0 !< Long-shore length scale of bathymetry. - real :: Ly = 50.0 !< Cross-shore length scale. + real :: Lx = 100.0 !< Long-shore length scale of bathymetry [km] + real :: Ly = 50.0 !< Cross-shore length scale [km] real :: f0 = 1.e-4 !< Coriolis parameter [T-1 ~> s-1] real :: jj = 1 !< Cross-shore wave mode. real :: kk !< Parameter. @@ -101,22 +101,19 @@ end subroutine shelfwave_OBC_end subroutine shelfwave_initialize_topography( D, G, param_file, max_depth, US ) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables - real :: m_to_Z ! A dimensional rescaling factor. integer :: i, j real :: y, rLy, Ly, H0 - m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z - call get_param(param_file, mdl,"SHELFWAVE_Y_LENGTH_SCALE",Ly, & default=50., do_not_log=.true.) call get_param(param_file, mdl,"MINIMUM_DEPTH", H0, & - default=10., units="m", scale=m_to_Z, do_not_log=.true.) + default=10., units="m", scale=US%m_to_Z, do_not_log=.true.) rLy = 0. ; if (Ly>0.) rLy = 1. / Ly diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 18b1fa5225..d59d271471 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -61,10 +61,10 @@ end subroutine USER_set_coord subroutine USER_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m or Z if US is present + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth in the units of D - type(unit_scale_type), optional, intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type call MOM_error(FATAL, & "USER_initialization.F90, USER_initialize_topography: " // & From 763ddab846f8b8caf2221e5c815d68a154d6482e Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Mon, 6 Dec 2021 17:48:24 -0500 Subject: [PATCH 05/73] Docs: Add NASA-GMAO to consortium figure This patch updates the PNG file of the consortiums in the docs to include the NASA-GMAO group. --- docs/images/consortium.png | Bin 137969 -> 77829 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/docs/images/consortium.png b/docs/images/consortium.png index b349caf28764c2e79f43a3dacc15dc85959152d1..abe48e5b1dcdc166646e9bb2e3986827b2ef575a 100644 GIT binary patch literal 77829 zcmZ^~Wl&sQ&@GI+ySqEVEs()Nke~sA2M-oxaCetLa0yOucY+6ZcV}>Sy@%(0@2&68 zS5!gO%sIPv%kI5;brYtnB#Vwhf&v8vg)a9|N)-wUmI?|A<`4-1_ymDztK{v^H+fkp zsMoij-))8QP*7A*a#A1EUDJETIZG3U%z>YW!? zXzqmTvCXYkWNd2Sp?>=y(abdIk+kZ;XtJAd8v_f2@+rmSvzd2RT{TSnfY2Be?rw_L z%_>zO76^&@|MwS7MuD&|7L6IP1Vb!b9_2mS53G5w?Mvqljh{+yuepIxLa}JX>7Yk^ zQ70k~w7w`F8EWg!Jq(>rUQ?MF@?|dvxvqX&XIwX5S6-DR07OaY$HLGA_OqJ$SyjR$ z87*C(>jrG%`>TtN<*DOmOlthL&<_3VpWqZKf7O0?_Cc@`(E+1lcc#)vs8nb7Vu>tm zqy*NYIm&XB4v!4l6RlM91}O+o!Tw*KFA{YZGeslGR5P~7bYOy0+OFo;X&ZR34rn6> z;(V2nW_aV8%(H5Ip@|W4Lrk>$c|IG{_p_fN5k0ld-zG6b{^X})_ zpM!-7bK!K)d8dV@(-# zA#!TDU6vIdosNz=+ebY+Uc!j3p=6wLnTw)wA&3pV$?1tPB+Mh~B)0 z${aMquvkO>-V5Ws&w{i7!8gQ5D4ywH9N_t$^Ec&2)yek80+x~<%E(V%D&z(}74u|R z9Dj4&=TC!ILlZrP|1FNCN-qEA7FCHrEb{`Gf@}IrYR26p-saSEuZ;EDP6CByxz@(zB(f&;C$s9^gEM8zFz15AbE(k029 zctJM)dI>)tI*Bt>_jEGP3(nI$m7_-An>D^gy;<*%6KE><#}rgX$>X0wXv*j*K>)7_%_WCDC-iIq896rUHd-SrYBKJHfM3qKMg?R;l@xuy}lm0b7zpT&6NKS}?#%A=zU) z7g5i>r*rIb7ytGxp!&(R^;PqQ)ylnpP#3 zev46lAo@e~Y?u;=b3o*8U(cXY{ZU4;$Q2HMi%T0IEU-%yO4!jChw3yLa}Sj(>imp8 z0Tu!BhXQbztC%t7Y!p@!QxB-HOT4Yf8`nxuMdm3hVjCOQL2 z{ePu0yh&Bm7)Ou6!B>Zb>gKZq6u3#4{;xf0k_eEn(~4vD-h~o}qAp>#`%q#W2b8>= z_AC)9_-Pw&RO?XXHu@}$j&OO9S+7C;A^zd5!}RrLtWUQAZ#Oa|;PJOQzJ(LAR-g3C zh9sAQ#RR?#`i-5HyO2qu;B6mn5|X7f=x9}SXBqQttD(7XN~W=>6}Y=*y{@&N5{Ad) z$9Bd%l0KQ@h3x09Z;WDzdLF%Rh87Tq6+5}~ITb#8(Bs-;9 zA&Jz}ym!G5s;qUij3!%bnQ_z+N)X&mQVmb(OM#}6dI5(`HM<>4D3`@SA($j`Jx zxI<*%JP^x>3SKHy%jByxv+i*J?d9SJqVXZhUJDQOJVHOQC8J5m*=l>XsQ{BI!pkkM z=Q9Ic;fI>h7p8%5p_ih8c9E_S)TbQiN>74D4yU%Ic7urWjiEICX(^uSv-C4^HKe$t zaOg7MMEl?g{yFD!}?5P$XhaNWVG$Baf<_!och0$tuF5%Y80&gXke4f-ma} zv^aW5H{$cpiv`qJJ(L#_auhfx8Csd00%$pf6%wSpv-X3OrG7 zmkEs)!Z@wrfdGO{L*}1D+h-i`Cg zv;F7{KV~Zdev%dk#b?Dw%=cyo?$Hq)Y|5iBiY;dHLF!()-** zq1GOtl=5OByOKCwi>o_Dseqa|as~OBP<%ufy%pr}Jm&b1l9eiWKj!ClP!Hbt70Au; z2X&87vEBEtK7<^oM8UK9?(}W4WyQR#YO0@6w9M=Jm1Mq&5{LC#s23B>&6WLu_M2(B zy?DORKn^hHY;|9qJ)VO{^Ku-wH-KM-xe2+(M#iT7FXC{*J`ZQ{H1$PMSO}xtk-Rtt z_{h!7)^UB0eO1Y!X+5JoTH0T8Sx|W0GO4!{yg5v`!euN7QS-!EXSVnb3T^+9ZD|oR zA3awu<7~E9&Tu`#TC71MWVkahFqlu6W7pk$WurCswb_d>0K&m`b93eP8D0;P9lP}x zt`+5IFg_j?JO96ZVBij;pJMYJ_k``p9xr=tp0ZB+xtMn!1aaBWv1KBl`UFR{cg8Yq zOum14KB)D*2g{&~pX8+POVJ(pR3*xFhtk5l{H>oxmW$LcZHE-lf0XVqg5eaDL3 zeUkZ3NSg>5nYsB(x&qQU;<17r72jrR;|)Ik^LE%& z+VgPfh@7Z2&K37-mBB4qTp#PxsX^LRy5bBPWI;w>e5BtkqI@6d)$;qXz3YL?doI^H zw#+IECbK^c7eFQ(?s`-28%saIueRj0WfEk`qAG6tWzE|D?yIzu^l)^TL(psBdnpJ8 z(8fn-Y#RRSf3*njgk@#NUZ0Ur;Y5&*am92C5xL&(^l$yJ9W}Rl^S*_PylNRcrPixH zu^5tnk;>+qJU;h>m!K{+%yDRbZf{(0gF=z&(M0lUG***E@)b)uz`TY{z^&YaLasl_ zcbp<1QqNqu1N&R+6ArHJk?jntKHbXnb(Zg?`r88k?SmaOMV6?fnL+Eoo`KO!0h3r9 zO(PZQilx}{n9IsJVf((l{(ud_CPtmfJ*Q{N&#osrFnL`i0Y8%x7>f7bEs4lg)-;?_ zBrLm~$~P+6Pyo%iuq=gyZPw-o&8h1d=d3ZpQd|?L=x=(VF~%BspiLYE6Z{^UsaQB3 zD^B7qQM2HYjSNqGnBk_GEv=$HTAnC2M#6^WnB=ut?ysN^eh1*e*dl$UqZ$-Z1pp6JIF_cbjWUYAoKgHO zsybkEV-R7E!`5`EcZz!GfSPd&R91WwZ-rA(7h#`OG>Yx^&l|0vjy$>G?PUc4^y7FM zxiCvRgH?`$q^*+7j84*|dT!rG-ysbMHi-T|U_&Z$#Z9}0x#?D1BZV;*Fd+$=&-U}p z6^_PIIpQD7-60ec(GJ4h)G!|)oSP}@oT)2uODy+6!c)zVMbdanZcD+HZi*6Lx`jud z1}eSU;63x+gtGxVH$S!X{Hx#Yian!!F*8K|^4qnj_|0|oBRwc=n>B=b z03`cYNk~52VQrWVIA4lYZ_c3qqe7@pr8Mn~%7vagNOY{u%E&#{84=5?<|IfE{mpOS z>~&m)7ggiucQbO+K%^IV7aAi{YLZKbGJTl?uUP4~fcgm!%--!P z4JM#ge=GU!V5YtfjGLR{ne^jw6x6}oDS`0-ESYVIIoCg0SyA*w4vc5Yi=Juil}+rB zzAK>yn7iK&kc-8Uz061?2KQw|GebHff68bRLXvIhBQcna<(6A~=%y*USRIycS)5x0 zR%ue@Wz!zUAX@A$u0e`h1I$GY^_GyPq!mJ8x2h)&PAA5 z0q6>$o^eIFx2?G1ey9sY=!<-ue*2K|$R<^`At9CKfAXuhn%Ui_i&;)DUOxnNSx&R062oz*Wk`oU z(E#}WTvpybUFU8SpXl5G*!?Jkv%BHc*Vq8DRGnNllxc4GQgkcFAs+y{ACFlQP~2&B!|L@_d9b23Q8Y@5$eVH=D zZ(-TI?_ZnY3d&m~c-{<-`Q|U5&NkFB;;w+CmdN{$;AF?!=f|^;goI-rl&%tQc{0$f z#r79)186`(wd9~9s`vj;{|-K218pM$XEU^YbF*1sQ+VuB!7k==mSzUz$d$sA7fQbo zUe^Vx+>y01Lv6q!IDVGqtHTYH$Uzo+5K&DC(sJ1NIsq{Qw{6yHl;#Ti(V^XBjE=)g$ zi8!0i{X7=gzrS~(OJ?A!=7CObvt;Fb5{+*t7}+SHXVq$V5eGgF6&S&dzV8m7d4d$~ zxAGWMY-v`|PE;2u3m)HAV5YaldK)u1nnn#iSzSr3W^l)J*N?dMcJWm6_zYp#>=u*- zZ#CNm?)ZYFxGqmmfvO9tH4-vnJ~)?EF%ks;jFV1 z9!h;|6lqQ}$8!TDSgs>%jfh9%{~t*aW-pli{b*S*VTsdX0N)F2>yCq?rU4P2=xjUN z=%(migVTE@?mI!YRw0)UCHj?$gVgBb({Oeu?u-(a*t>O{rpip4p}VwO6Et*Z-KmN& zrq{C)b$GdP1doPc3A_;1S~V>9r$10+TD7C=08QXyboMTO=3@B)Q(9T`st5{g}w8Z1V(!?bRh`qLi}Y1V>NTP+s`3n z94!kuD|O0w3ago3mn=R#TWKzmM~kJomXup=pSRptFK&7OD;kodmhbfXiJkWN{rc^= z`Ahy;hnEJx6Ak9WruWe+N25Z+g{X-a`~LZ&3lE?ZTV2W}un?A0N~>8n^Vn8n-)MZI ztm&XIzdu=K$^#JNZ?5^F<$tIPE82Afel7Uq2-p3j6w&b`n90qpekG;tk!YKj8&5Y&AFjJc&dVng z5YrpOf~{2I+hTw8=zGIk5v-~~)xw*X{>{$UOT_3< zc)pTsmNVqnrLI|wqhMuU7uW5E8*L}4KRH=|!aN?$PjbOn(uYTn3_p;p40Z6Zp41BM z(0chwO$?+!;r01_2#8-V*jq8`NFmc^DIG|{>cbx)#i<&}t!A)kH;@Q($n971_MF_=NNsgl4ptWWmzVDT$IfG9T!DkW`sB< zVAcB@N~EB!W>9bbuc6EJ81eJnS|QJNPkdtJ^WmlHjGJGB)ecGGC_gPyfa=Eed2Yc| z)Q%gU=Se^$(Ryv*WtpmhzX-Mi0DYSw_$7^7EmflLHwXs{2)_;a1(dF}V2%ZRE`bD0Mh}xNz)YwJA-y^7o4h7(ibmTD-%GkBT;{bH0|_YUk7UBneD1-;%?p&mTO+QnOJLqcMe)4l5~jLy>4{ zsX$1--bpY-qhjxTu}IxzTWcCZa)Fk^(9%_|ow zz!&y3{m|Tp}cj#r*$Jj6U#{#^G+4Oz84W}-Kp4+sj zAG;!lK#cHnD=}LqeU3NKEq)pus!#Z0U$*RI7<WA{$PQ)c#G+FIe|Dc-zv>N`nK#1jxj2Np|G)8at@y*S_t$6EM~QH_3Sd5 z%cwZ0JJm*bihtqMxqU*(nIrCM})sMFh8;++?qR+CyTu` zVT>M_U|G4cl+U;gU01Vor9v@%Hzg2fJ_KUjAAHrDLg4&+iBRUb!8@a!(B!cVx0=Rh zr_*mQ58G6Hi4>QW=i5_YvaZ7WOz}z6zUjs&B5_4R(@E|me1U6QE+k8K@4pU|&N*Xc z#2!D)Jfd#Nf4)coHa=agn{u&sb3hiK9B{ez(hn9pbzax|uO{Ladm_#)@8Hsm zO?Du>Z8bgH07cA-&HTdj{dB!Puz_Irl%vx8-Pp+s`V0@NkRzcVF{K};6(D{@ELsGj z^s5%{%=YbyYqmwk0z}#=%}G=FDP0Y~6mMl3j>zW3b%XCl?eVXXK2~;)7W^xu2S(*K z>{fxkoYNA9^RQcEgaTN6^*$Uo8HQ|B?3RMP=9dBSc1psChdIR*7mQaIPyGhCN zCB%h$-JT*O_iN@0WoZQ~VZXpMwzHvP`Wn%$DopAd{Cez6cQ zE0OY+4)A`Va10j9fQ-aM8GbN#>LNRin|Gw#Mo#f%I&pWPOw#u}Q%i-{Z1g?i^(YyB z?ns1`j^_>^Kfdp|NYr>=Vd4Ij>Q2?_^;WxwO`FWPT?9fpkJlpY8B4XZa2-}6Vg(GO zBIB`R_rS!>?^9F#C-()k`f33}%cabtE4~}N zj_`zEE!Fv7|0coMV--IHbaONt5F9jnx>6zhS*uON@%`8f?}($=soA;*uvjRZszlCb zMKnh`bWXmeM|N`da0FBmmp~uPS&2u1GoRwEP{*J4z|MlH0-^emg+}vRFn3CA#LjBQ zQ&&7RAjlB_&A2go+UMR8&=CSeJ~nfnuT+xLa0kDok>C3?etdak2~fr=6Y;Y`^1<^OCa&n%7V^6G z8+SwpY&0a;2!lq5J&p12JLH~{(Rdg4Wy~`7Mxxz93HurQ9_=`K*B~s$8os?|!jmC% zB^#kL9*^w{4ZxRG0i9TLK75m2-!CdCUQD}Vn1O1hCr+a>r%%sfd7y??aZp_?gZ?yQ z?Th)5a(p);>1Hz}HLJ07^^hO31m!x*Z?SPaA7Xt{pPGSh5-cxkTOatigRrn^=B`__ zqh%MeFO#O<6QNDySTm1|)4u-P1n%WY?=wht)|`#-p1VFFKsf+PNX5Nc6BOo(Hdh56 zQlkDimING}h3~k2gQ`pRsI<-wD8XzBvm|(P`41K(``*eIygYXTt1n}focn)g0s2pU zL7}1GwrtDSG9A$+qWPu(4f>kO15w5ucM70h81u?y6fW;8jos3PFICHs5B*3_OEuBK zC0-!aiz0ee zS*3!P+qiQU%=^w)Vg{fAp(=p_bV9kZ%=C&c&&KD;p9Q~fa=GS&gg^#b_TsGG{h(%i zZJI*y$pIzeYQFkMuwmbdQat0jd7o6714r($H zTpwwAY;6*l_LmKQ!bW7Ggj35vthj$r>Eg?Y=xm7k@DySJ#_+zVzNr$XQ{&&0oAnp$ znYZ0-{kPm@T@J4m^u#SJ7NL1AJ)fG~Ggctk;HH ze3qyFFh{Xf6?~w!R5{peXNDd}czsti=SzIYs)$UT6N(q>FWWb+quO3(P2=|Nddc?? z&R3>5H#D9kq8+w5qTOhYpw1qc+Q{MP(~sA>OS0zwM~Q#WSZ!a8r6LU&LJd(wJ+zq} z;Jy?V@~KF$9N20XcFU8LSGd^5dmB%o^{nc_0Uax z#p+Kad8Qw-6+Vvm-qF3b#H)S~=&0Hl_kOKUheaNK!1iy7O`lD*v9jSWcbc!7=)$;v zErPYz`H?Opc;mEA_>}K)yK`wwNP|NUgYJupu4rX=;Qp-J#|&)|T;9_A6IXI)5|wyo za%woT$Mqc!ZvQ6*I=<00cSdeQY%Vm>F=L>a4dq}hQhBMYbW@(*y|9G2tG?1`=QFkD ze2h`H=FuT)y@cRvy5}L0M(B`E+%a}HHe_Susmpi&C|}CEuDIUKm8pr8{T3AeB1@zf zNUCr9445_GkCcU9s-s)f`nB@`fjk<-2b|;U8G2m%^G_Nthv% zhl-Tc@SegTGt0`?A}702SQ}uL5OxjTOKS_Aej|9EOf5Tvu}F;|*80SBD`JSp6=WQ* z5fo~M;JvYj#T6xQ(mL^;@OoK8{&gj<$OlP0BROPw9QopXO{U^V@XMiPN!T z8$`^iABPwOwo7sKKMtb_)aGogTRrD8J;Zzh{?;``^WeM+2}L{Vs1#GY9Jn&FQm@9v zc$_ijqf+Pi>iTPpC;O2vKRF?+oS=`L`-fzE!PM@aJjxZoRCfiDA6l;<2UepDOE@Q7@kfPB)LgHXBQlqS|`mh!O_B zM+ENDeYUdWqW|%Rr3F{hOp2o>}#~U?zXleoCPCJm8KNF_YK;{DdPme9TIz3K=4@(#ko|K zdc0IYE;W(k15n)ic*M58CC%yUv^&!k85s@(^7M9aOTM4Y-otk6mM08a-`W~Pp%wnB z)90wKCdShV@vji%41f*P@Og$+zPg!rs=3-pXJqG2sQuYq+}Hq)*@MMY{u`4J32rWAI}iYz$|$UJrvJy37wd(7M;74?#LZ-Cz%xtc*wK+-Qv2 zUap6Adm%%WhWu`6%@o~n=xX^tqb}dmG&^f44ZF`;iXTfbDTg`vK5#}MyGo|0bMe5PtwTX*sGA03Tgy?dKB$!iwBl5w9FZ$4}c{HYe zs}0k0Xg})9DBQv8Mm<&~VIxs8{^~RcX(rDXk1fbAqxCHJbyJK?sliv_iHzbDp^Y-Q z{8j=~ElzWBRafai;n~pFUf%9u`Reg{FU;G7#!GJYj8w6T91NXRer{*wm}jxf3+28{ znYn4-iXq1zg1LgxO1TP4XtB`2p6s_&89-k&A=uL^pv8N-Ikv)N;cVk4XV6jPN1ZrU zkJM8}o&3mf25tU=QHsSv2i*qS{1Wr~aJDo(j-oYNzpO)pk3~(GT?1UtQxEvhW$4Sr zd28?JyvCuE{G1CSIYe*W#_*W=uVP=8Z|09>8|o)%=0)hk3*K5R5ONBvY9$?PY?0xe z*h&8@`j$BCSimRnMr$H4hG%@6@`S%l<||?l6j34W{3yNhw3O9?Y!)N_B{Te2fYk#; zarMq5sXJs^uMkVS*zd(>ZxKvKXQk^9FV~j_1h2nXQqd2Uy=6k-+qx&5CvR;TbkE@N z4aOhow`VTe;sdc6ScCYm52?+onsc>zCwwIbUZWM#TdKXV#Q_-+(~VG?bLIblW+n0A z?TPvN5q!{EhS2Nkafrjo6yLFYA2_Rz@>o#cREdp}|3$Q7^bTN^LYe4*XgoJiE@7fV zU;Oav^4X1?68+4MN1Q>CAWqb#O>J(y%}N~3B7pl9BL6~6{(zW8C##WPZCCprzD>N#%zBr5*<~Zr3`{dn zZwq2NSbML!-6bh~mwk^3Z7WHTibYdA@U`NpSKOddR^A~i9ogz zYP+W(|1cTs>m11}+XY1bDI=h-E&EpzXW%n_;3WSrda&8z5HWmT?cv>7?3&Dr}y<58G?NSVttIl2sI)#a8Y)$zEGtrKV*xbfKK#}>FGix#CT`Rdz~TA6AAm;1P-ux zQtqG-)?Zo@*%#!aMfc6)CZS4)m#_x-&Fm@hrx;+;slw-#;)x5(`+n8{A9a0V>}jZ6 zskf?|;57l`WG=L=jTQwOGyBj*t+lmJ5tcXAC29nn6@4meZo0aqcRpq#Af&(!5l1_te$n&c$ks35q5K*yJ(AKV2JXPp|dgjCGQG-Xd{fmdqD8} z+19vffDva`rp*hmg~9vyiO#H^<;Gl}M^=}+zQy*THDB8SUY~@#{N2yr$1p=M_sE_v z!@WsOuV`}z2^zS2ywU7fXiG`?@{`|^6 zj9{1a*?3J&&#K-$dH-cC7;IecNmk+2TdmM?O=4x3gpvB^uoqp=UN*f{vI=5XA&J0%_8E%X5RfFe)5ZFp%+GX7_PD&s3QnFTYLL9Y?AZBol;k?W4W=%x+f!#^(Yd0Si&_-rQ>a8FFSt?(4n(_;jY{&u&#<e%59ZrZ4NMf8k%h#gXTUxH~!@|Fet=Q2U3C z5ib@I0l!0wj^HPuY#fqt!WAu0SonzR7GYG&YV5_i3kqQnBEo*_9W5Tm1a!A9hHjy7 zVkikYyPiQD0p;A`lr4GPhNc1a&K74+3c^hFJJ(VTHM3RcGW|jeXLh|QGuRlKq)=4s z86d)cSHVm*UhSeb9-`04(afcvzt9^f!wC+=D*9={b(8r+>NiqDoXU?+2|@N|4w#*f zn4N?bzS%y0Tg(1Olr*DCFlR77JSrAvT9brpr>EYAF<5@+j%}6gJMIgZRd013#co|m zBu*00unZu5{D6zXVRF3bncS=ATc(2$?B=`2Mrp%cN^gQ^H(;gaWb3Ls*tZZaA1I>l z50RDpw4s#j*DGNRuw8y?V!sbB)nNQ|-ZvHJ@>j|uGEBD??X072GWNN+M(9 z*Fh4PGfjb58;tOI>)Kt#_k~rfHfX^7g_Cj90g+Jw^z(SFN^N5`7A&FGbnM)qk-fJL zQSE$=ewwwD*SjAr2Oo1f_P*~eMhf@V3=Owz3D;Of4HjQY1p(CSTht!TULMjxNrGL8 zo9N_2i)a8T_d#tUuwBI_p@oF zh{X{NNSJrKH)f1WO_k(SrDPKIC8#G1M?vvXYpPZW7`jnvziB-HG;4#`X_(sI+QE*M+VXWS z=0T<&%>*#}zM2E3l>%|Lu&jwtBVmE}mJtL)oqUIkuY;>kt-%zBGn(h~e2nyVR^;Z{ z;%9w0D;rGNFTU)_lNvJ7x*dwruPZ@xQhcP? z%K^r%Hjh3+Gbh()9~u*heN5aETMaZ?7vwnmb-)Dq%^b`fCX+;We$~KWj|?nOp9ebI z)QV44ROK2T_=p@PZ3@%;VwFF9wHg0-RU2N&P%?@;g{HT)qI6uFb};jfSCKS00gD=i z4k&1U8DpBvYGtrnsWXO=t^Fm3`HOH<6zz~W+Q%h3Rb=ej*UnqHsSd%0I+r`kQemj$ zROqPuN1J5a`*RaoGE1GCR?P7UeWk3F&P|dEXD{_1DfyB`L%M;^9N#g|`Zs`h!!nlv z%GYbY=BBXh*K>8mFeDzIz?~X)U5MC>%BU*9f3ksf{+-Wr!Ad5!#xVK0x;}`+vs|lk zm4)^9TxrEx?mzTQ2B}8GG`+CM^Akq0r6N@5Pkw4?cIN9Iufz5&odl}Kx1)n%gqUTv zjYuIP@Mkn;BQK_MyRO7B61RJ`^8x`=RkCm&Pj2rP3gF9s6?GtQSTLlI0G-IBNm{dypWEz z<6nzLvuD$hD-FZLAbRMc2v^XvP!%w7f7KP=nHlm*e=}# z`xkawxM?q!xcSAXWBky|QPI3aD}4Aq)Fil^`)&}!{drRw2PXK1R$1yTsMp?Dubpop z50}@Z93=!rqdCFk{+ch?UA%qkcA|GI%Gi4`;zIWHTyRCD9NWzMM7vx#KT9s2h$8T` zwF@QsnGnWes<~j%$D?im%FpOF0b%9u-v^W$8RriqAEWfn3kJ?gD!3vF>C6$Gyy!0e z`C?&z20V2O-OL?9XotMfyY3XrX%K`y)LDNjdNLbuC!GiLgJ&E|3&s<5dgwK_@Cs=> z)BG6sm1zp;Eql*uL1c`)ZPdZVKnerl-ZI?%QK9W~aO?J(A}IT}|>_uSV*Oh#;lA4cGS zrGOtr`~ppS$-F<{1f;y(ashBE_zRI_dL0h_2Law)rSF)laE2KNA2-w0`N3Z5Sr2t( zh&sHJ>LJ+X9JJhiUl+6=3Q?2NLtZbv>fcgQd^`*eIX|r2@KY7`i11;aDZpvp9#Ji? zz3(Y!Z{HAZ^J`zk?S)N*J>7T>apHc_jjQjtp*0x#oX<6UUfVXiSpa#?fCYV=2j{}3Lh{e1B*Fo3j;6agGlnB~dBSQ}9 z-26g~-~Fl&Y3; z$j!Gb_8YORnpbBSKFvy z@|@F)%!RG>I95GTefZORE;4&DEUgDg_THig% z@=^2mx(Q#Mp}CNKES;&P0)c*;*B8J}+QMzDW)iv1JTq=x=DpT;nj(mEFJxnF_^&^U ze=LL>fL=n{J9Wj^gJ~hjG2(sO+UufEkSK&JxZNM_jvt*Atl)O62n*M!U=8gC8l^sTRws_9UBZ$o=VE1$kPLj4Ww6}WvfYvf()dpfr(ZfKhWJ! z8O2J0uE@ni)D$bVi|=g6Yb5UgQzBtg(Dz_u{O_cZWLnr-;jf~2aV1TN6>V#O+U!5b zxhct%pvotWuVr$J3vD+ua47+;$3WoBU!`J{nyzjSEj0hjRgsPIZ>}EVTpDbPHyDVn>wtHgV%DyUwQgaAq)*x`8)6kuiN%IK!&(#Gz`;KBG(T~G>aM90{la%0_ zaG=eNl!X_&CqOo5*?XlT(pdE+mVOFoeu+K0bOHm6tzPXBkehC>-9``c#{E8rlK%VX zhY}nIicA;UhBia&tOU(_DLOf3v^nwbIi$C+ra*f2`DuIb;44BpGsS9}S29X-;g@aI zx}5#XR74-~ciVv|2#J}h>KjV5UWAwqqdg>ugA(0W*;}{QDX}0bko0>{vXB{R<`S8! zl2Ixh!0HdTH?5u1Z(pq0@r^)=)W`CV`P>MUrGAfkQMd5!{ezlO>B$m}C9A}tv|d#P zW5mUL{lz%~6d5AWdOmSeOP6v;aUnn(Jo+v!GqpgrOtv!3Cwo%n}4peGz%215dM)5ShYvE>4on`q4)Cr=J?BCB!zC!P7T>7 z^~nLYY>tVOGNAkJ`tUU*igk8Fc;$TAeBkw-f>DjkM>@BzgX4+jXHOU{4gZUYafmVQ zOiOl}Vv+L)qX$uTX>o#IWze|d4MLSAM47iu2ZAuZg}~4Y2}aX}YWKTsOJb|)pE%mp zUWKAN<-jS*IKHQ0%` zuIe9+^K=|;kFjV%SkRe}6aH~B)BCAP5I-Hh$U~i9xskX(>uAViFXnNspW9MoYNBfu z2rESn@$%YiT@o7L?JZT71DeN~ia4u0j&x>1+*ZzHOMfCN@RzIiIPOe%F?PRzgvcaFlW{ zINRkHR+=Vy57kGbygtoFcG1?C>l3+lTC8X)nE#NIHvA`*E$`62yff*+*G3d2V;rVu3@bvw=1V0VTP?D4+gB8d_kqwX=~IlYMY@$y$dYc+yAhT>jfBoTS5Eq%c)tPXK4jIo zCiUx#$oA#D`iKPQc^D<{N43+z6(Kdgsn+omHV_;wvxJnF6wI@qt%Lws^ogMExdbW| zj$RB%V@NpxRsuOVF{r@QFv@KWsubRN3IA_c(B_ZbAKg$mr!-rgJS4Gi2z6Ph|9>!OTGM+)DB8m$reghjkF6Ez>0mHWBnP5c%^5fb@_zp!}iZi8)LDRrJnf=$-6&8 z56&(vr$WmRfayfsBf6H+;=CC(R-SYj>k_!jjyQ9q6+^8wgu<{}B zHFds*m14yrWM*FlX+kOw3cE{Sv}c2t_($rBP@p&|KLuJhd}I}{&%MK$D1O{#=UQN& z#?MQ2^!%d3sOhF}>V^GK4K)A1vjA_B{fm`;pMDIe{MZtYO1j#haunC%XO?>D5(AY$heU0H{EkQa`(jlosiLBU6G<^iN?d!!dBZTP3boAP7%Fh z;2RJxiJ=wca$vHRHHFy5l-K0`5Er+e@A|2yEy`ugVVCYA6L8}OnO=CRHci8$y5?n} zN1oy(@AzR@u;LbogrMq+WWOo1jxn=8uQ~gQ)i--cr>u@UC5U`Cdm=b84Yk50sq`tl zL8OmcjLU&2&Q`PTvEhi-u%DFjvUd^v>2%qicl%Rx*#1!Hh`z3gpqvW3sK_m0RwQ6n zUSuHd1?_3~-uHBDB)~|K>A2$2x!hKJtqgpGp45_&3JG>?>8UUFHld^v?yJwyT$*KD z`6X@S2CqVGo0-xO_};#(>9=eW%aV7qnOKVSquY;dE`8m~$SAjai{Q>}p@_X1{=_iE zxew=i!fFDx^tr!d?+D@|mE=t1y{RwjPm7)D&0eDQO6TJPj8f4QEykD!kV7bW6ykk` z^@fwD=~Q)Oc<8-ok7;QI8$8TuRyZadF0`syBfLya^J*h^BS)FhDP(4+W%3!C3i52o zj%UCvxk%V}K+tVUHA%{jKW_Vqjbrogd4;E~=qPm^R*A^ftLz5S`J!qLJn^rrjt z%K-rsf)nwlR<5LYC2n@Pp@FSc>;QWavh81q_6rG=B_p4OY8+9r^c*G^1s8b+?~y&;j;QS^jvQ^sf~?A8{{X85+_Ws-W+g>v@3H7nb< zgMVm)d{H_f|A(iq42!D!-kza5q+3Ag?gj}FB&55$yIWFHMY;r(PU#-HOJe8_=>a4p z-!sqe`oG`j%-Lt}mG`~&S~&JoPfz|AcxxsZZ{G&f;wF)+R5#Z8dWF9)dXTc-4EAqK z*!`P0d@TN9MDR!;IW<{l_n%I%a0;LY)7(X`ZM;;v^UKE8GKV=08anz=K#y(; zvgy}1@9p&k4*Er*K}~fI0plNwY8Vw?_ zbz!lr>9fE@Yf=!~VoJZuGEcdaO*#WKh&O@rw*YL`jxm{V6(Q7J+2)Qv`JFQvvaXIf zsOoe*t}90@;&XVRddSLDj@DuT^Ob!>+rwo|p{k(+Ata*n9hgqG@N!ZWffhmDg;FIv zg5y_FVoBHRT6E_TV2eBF$GMbkszJ2rqlP1EwB?r4l1*7)ZI4 zC!^(i*cAETacbV$^vTSy*plOT`pT7ir@BB!#+CyAbXfSq5=FW_V30CJ;p)ttW1IY^ z|KQ?`EVZYrJ|?V&nA{40?wiiM)I$@w*-s|aIOV;&{V(d1{agpcjP;wdpE-<%4fdhc z301)`jJHni@85&p#oDW#)Xt_(M|Vw13i<40d1c*N8;##DHFUXW#5WJcuq1hXa_WyJ zV1z*rJcc-grSw&(?S%c>+g*{j+kRZ^TJ39*Iq$iMG$pFJ<9r(lP>*4F2{<1{hKvZ6 zr+X5u+v;m(6a#3{0#zZIq8%CWA-0b&;xFz#-tD)w5s%k{*=UP;C4TZ|Urm|Q6EQ=dzO`HcR@OuGJMwm- zlX+)UaYM7eHRwuleEA!pev+h@-rT+TF6_{VYr?1{Nu~*Nxd-|zaeX8yF}(CN#>K<| zd%TwC#lGFib2WCn8Y^ajEku53Zo0diu+zJ|mS3BHa(+}vY*3%WYk8f5NqGX+luu{*pH4trO1_?d6~qLJE(BO! z5!!}N1nLrcy!Ohl|^Ou4js)nDU$9DJQOoD4A<--3Q)> zC#vH`3>P-U;2&5TmQr^gEeUPEb9=WO<7!M6Lar0cpOO`l-aTSaP1^&sjWHL)&co%k>c=kv&sMU}SD^J~Mz7)qaj|AfxC`JvBQ&R5J)Z8^~K@+?UlxqnCmDe?4lAj zW8g(Xh`st`E7@U3MB|jaFb@W|DXsq+d~yZv$in+>Q{lyS27@OXoxn4^s;3 zg76>A7XS&Hbqkzi%Rvi4_-i92=EvpS)(LOLsr;140eT z(@d{=k2asJYcoV&rvt?`-NrlEBaYVQ!HlYzuX;eQ_*hyM&7FWle- z<6wz@Ezw;+Z5ZS#|8TpDc;vm;(BNWV2$Fo5)Hk~CC!1oax)VTD2_KXQ@5;rY5jXMx zUyPz|;6zR*n=WFdUzKXj{w@27Y%9|wxx_fBt3&zpBzLui`103lu{(6bOh=Dgv)bK`)P_cvDLOprG6^gC2`t41yo-qB_7o^j)xfx`l zwnW7Kw|+j@G_v;Pw)6XYGq2|}k_k zU-6S_e`N848p^(jj>oy%5Ttf0h{;hGLv;Sl1wO$WpNjB=(ardBT0Vq{mSGmA;J~`Q zj|KV5G)}!d4rsGA=u_p1^V#gnJpp!85?2fNV#bInbx|!&y4H`>S?Zn+QyuuBh$Rm5 z4gni4DiAN;grd)`UYGcxfhUB0%R!yU5@2i4+ET71xpg@`?!e<5|6>4^M;0JLWewE{ zaaj9zVOr1{N+@%NTh3S9=cWQ(hnQ^W>fKrVgS3QET`sU6u6B8+(M_Yw%vRGAt3MiJ z_lExM#3BG^L7J?8`MFdE`JGd1qq7`z9=o#g#7B0MJPsZwv-~G#+PEV%@7B*+1GRFPx0m ztHk_Vq8sX&M&cbgmS;tmMn2?K#kxGYHuuGA7_U5$ORHTJjlBaa+yA0WW4-#1m;s)& zopP_>HmJ*t_g-tX;gq_#<8?>$rE*uLbv>;grn^P?$ zwY_+otrL{>Rr<&wsH#Vn#xT8-tLZ{QrfE;olMEytt+N)=?F2g$HQgI@?LHao3R1?v z@otQ*qP@&!uIY$EM&szHw$Ilw1ks4;T|S}atkod=kc+=+@C#k%-8K7 zu!6{G21~rpvKh@U?0vVPUcoBe0++)-cUJDPqI^M(7XC&Z zgwTQV8g+S`TG%dlk+X&q^J}YCM}ezth-9Z;!*|=EYm-hSR2I=o(EQvdnMipxXQ>Z~`8^9q9M%jt{1eKoFax=O;Le|EXG8Mds!9YgI!y^3U)XDrfaZgYhIEkU2 zU($R$|4G(7+2R0Y5`~Hi!r`e9k)u|OWyhTI;1oh z`Bhc;oVAbub?O6_f%cpIrJoRmw#tz*F6`=_D~t>yzUyqKTk$&)4NaAzjr``5g|p9DOgE+Q z;Onl6Y#=sYG}evK&{A+B8!x32#UoO`%A0n0uLC4{SZOl5-Cr6e$qWEDcSF$#a=ots z_s#O;ha6O~0k$~VV*{i{ON*75Wbq-ejU{;zF+scKokgWGP6S>j?SG=E|3>AK@3fo= zmq;T-X_GE-Q4#&f!{<~ zsD5GNcyjYPjiU3hKcw{0ruBmMwo7z#(_=Fq*9=lR*R+_s*4#h1rsR8WeRS{fyy9D} zL2FA7o+C zNl%-56KQJ+M=%~LMtYZrkkNGGFpV!s+aKRu4OaR0vG6>lBSWtuXl?X+(>=%SIoqsr z8&)%*Ju?3y)XHQ7$2C>r!ywR5V~)iBxwdVe3xn@7q_L}+kU-er$rH~1`G%uQ8~ z^juAKtK4-j6X>3JSA(k%%uB=;aJ-{~akFX}@A@Mw7@LY*s2Q(Wfm4NdfPTE&=&P`<}VueB0|Z-ozFoJd@qppKZTLFHcDx9J()9kl&Tpe0ZTRdvVpOEEX_OVt=3A=*NoMZai@? z|LF|sQhK3#wn8;ZbB&yvuif4q=v{8(Fp6E&@=tCJeOfXlq74b2VBvd8 z$6j2nI3W-*h{J15%+%0Rx9ymR)Oy(*3X(hf4`fPy{f(*8@;!JtV5D+Fca!~a?djw4 z=7WLRc%Vbj*8;;MmUn63d5i;lY@3hOzIf6{Zh;4``jXpU2>b7h>J{pLHHzEkH^h`2 zPTH}_`E9tS7C?ogR1u4)+E?QnnAYbY+)so26neUGxWOnD6_W&-OhcTkF4vX7&G6J2 z5wQyWb1)ZQt$1~=cxpD{oN6K*g^ISGuvk2GjH2`++KH=A$o@_Hr4fH_-Gr0fFi{@* zZ@>A=Tr4iAxQxf|n0ah$VdA(l!zJEyGd+N~qi@@4si+c=1>5<(9c@1V%L(iX z#$=a~X>LoD!z4oPYfBY zKE-@tMJTD2)bCU_<3+z8gE$;|x$^M3VFFB+J(YNFqz+COyC&2=9yYtkmJ@rvSC3*G z;4P35>rLJwOUd@#DO=O}Q6Fn9b>A51HOo~&Bj}iKI0GP_`}W8~xsR`pt6>19(i-W0@`SEV=k%>ESKAnd2qWv$*ojhXDP zhdcy565s~J71?SRZqY7nX2r00u1z;&?wwUUbR$%oy4Ip+Gm0jFg0(`BoL_wD7$-8g_s z_vISd`wPD)phNc%*6S3dsCL#Qi{gKkPX#1N2e1&Rx7;f{M|P%JvDVJvQ%Y&1@K#h0 z4BA913gHZuu~6|%mg5h>plg!mF9<)l9r=|shARfkw!&C|$N~U~&#zlW8?8^kQjISTiW?$t@)D(lBMyMcpEJJv0CxZ5J>Lyy{gm9mLw-x4qZI)*5!(PHgK=>Q z#n_U8Roi8&&))duWQm6f$<=YsjK>XJh(ApaI_CvkZghGkIQ0j0jhQKXbI?@k>+GJp zrX?FhU+?Fu_1YTA46=o!HVWcK7ij(|$}oe|PhoIzW~%mKK1%DOCzzHCsx&$7H&DCz zQY7TuYFDM(%6jAo2^vdy>;qJaTjcdY`Z9KGQu#&p`v4z6fO8xdb);$sWdL03?Q6#0 z!i`!f`>O(;AZnv(_w@!u|3W4VdJ)Z&R}%RS@=J1Wr&!qPmyVJYl+FLK>m&ncAOHaj zvq(sl%)EilbH^*Gyjmejk0xTh-q~<1v1?^uM2@h<7^xKm+Vb|UMl|_;$&1aNyEDRY z<8wh)vNikeSB)&uD5}ECk8ZRkh4oo?;n=XK|0FRbg2W950`-Khg@4lcSX_{0!$o_T|*}YAiE@ zkCo-73?AyDHgoKK;`b&B$uvS%YWgjFa5kTi|-8pwI{%1XeLt)rEGa- z1%4+gbPsw5!MaVl{ai)MRIkyL)*HI|I;>2>0A@1p-maHeHL~c@)CUJ3Ac5n%9pD>z zpYvlF&s;5fm$#b_WW5AD!{%OQKU_clYc{sT2%uF&V`En#oZdiVuXKPTh;XsoaCfm@ z69m5d$#D&ef&*1I&0AIb7;4=!TMcze9sOFM4H&R^4XqnQ%>T9#Ab8MB&iy6K=8KK7 zGBD`uH<+W5*C}kN?K+laJ$r8hfnA&szkh$6NcS*n<1in9-J6c^E}un~;4ARt`oHYQ zd&7#9)3O4TxMFF!3`BqxWO`$nDWj&?rPs9xP{X)REMoO#u($xoAR@&5_uuT5Ln!H=`w z>laR6_2d!mKnn5*`OdPu<1ul3Mn@afb1(_46D})n0a@8J zh=f1`?`g;`XxXB0*1JySplgUD$B6{-Vy))`^5wr9UL>`%NA8YWm3yW2)`AvH;miGx zSI^Avk{z%oDc@Vjk-ZK7w=V5mMBqCPY|rtDyE1ewx%?%-$Z0PV_Tm|6m5F4gNPTX$_M_uvBPkTXqr%XKs6ay9pn6Z=^ zzb*L;xkgwdAX%e2N5;LrFYJIW(v<)bU2q;4KAJKhnlxhdWNMKKo9`u8fx18p+qPqR z1qzvHBqajEpyi|e!=?aPDaTNhf!Y2aL!SdE2p=^;^}Y++-EjBFBA@}vb`yjPHM3!R z9qXq|1uVeD%LP5nF(9#CqLSmw|J&i$UT0o;z#ShQh5_(^_{Z?KyD1NDW>1VZ`A`33 z*8Wh!6#o1)7grXH#?~a7SYn;!oXIIBk#iTX@qe`d0r{yK>OkehwCs~eP~x8EH!lb( z@M>u|Kes*85U|i8w^=L*D0*fO38$1m-pr z@jxTGOsQ>i`C!dmIZ9qYC+R_CeTf?e@N zL&6jt*F97d|55%krB&J1Y4lASI0vLW(wr81K_%vu5k*^An~6M*`P}?F&aMbib&*P* zZ{b-pC66=jBDv{%#mXsLkNj!2$mkF=GyD0Uy*xlXBT7`@yQ0n9y01RZ{!ulrK{O5) zDR?S4tXrAy#{i}VWGrgN^YSj}r`5g7y<3szJ9`uf!<31A2SFxayI%}7iYDO|h>(4J zEju&X!xyK^zt85M^8;^v_*87m_wgF};Y@;SToUYY3~cc-xR+1Iafr3KRW8PWESJ#5 zhuSS$+v;SuU@~ONYbFr?HV?i@{D8`!1+cx*YOC95bI$f|2_H)J-p9voV8^BwGZ^GE z?&Zs?6HOE{TMoU@GvFOeR8r7X*MGa5BhU8%fa#071p5uPt~mIVF7++PacLh?&3!<$ zA9aOPZroppce1)jxM2jEiC%_|F+KsmT3fpz8~o*vhK*^p5>P zfEdTwHCYpgr7ZId5Ew;VT@j5ShVtUH*PD%>UjOfWZ zrlH|Cm&T!lG~=I2Gxmsn8avHp&;%Zgi+`~8p;p5!LJxTgj;giQNrhUFZUf~;XkG9G zo}342u;MYpw1CH?DYJk^{yo8Z>3b|Z^M-E~!g{9aENy>C@+kYBsxo+V zU7P>00kfVYz9Lut?!ISHcV z5|sj9hGQ?^z6~LvaYkxRarSy)ogw-;feX7yZ>8iopYpBf%QzNvd{g+cx+)NObnowx z0Y6uRj^RE(ClQ6ixn|3AzK0m$>zz|v@t0vVz%e)` z+hy*JjrDAe?mMj?2zAMm@XsF9i)u`9EBgjsBT(mDwV|(IKJ=afRrTBS#oCcD6PrSj zPIE}9O77hf^HBs}eu0?pA4;Iwd}OM@Bh=4Z{zY(p(t9nNqWbvQfB!NSs&-N@avfQS zGAESRpUqVimTgIk{0LyVtHAA%K{)O6uxv^>VfV^AVeg+E$C7uAsOn`}3;2}g%xXQC zl5dg>;@?J(-t~1udyb4>GE2Fkbb@|#?CMWRmp7W&YPGA@d;;Os%S84~L?^DyM_ zM@CXNBbS_ntO_eWsZLa*?h0V>RYF{1eJ(pcb{O}PBC`Dw1#a%ZX^e4$vURlbT+&FX0cx`(q+A0#n@QPy1Isy#Fe|6< z;WRr(Lo?GqO$cXzL?L~<%r3iA7}TDo1?qhg%T*02+AfjWdoD1X@6C$N=USC90IYiu zw7Lh3te}A#dI&FJ^pS^jFM;2NI0-#xy{PKO-7ccqse*i|L(FYe+8<3L_nJ%3v5n0i{PP5E4xQSC*uOAm; zW;S*rz<2hk3RTlI?(UF$wtli&a#75vdaNMZBa_NpZHd53kWraN!(RZZ`GQe>-cdF^ zjt(=E=%PYbQI>N?CGCuFuO(sE^dd!_*wy>0kTdVW7vqX1X=R-@($7FGmDaQO$cG-o zU)JxG+grn+TazS_NDL#{bR~pKa^fYnie`?Y;kNeNS?uGTJNk zaSO8f05-bE{A}jKhEKR8s(Gc?%T-04xnTSZU}_UU66(NiH!99FMI#35W(v^8xjl3q>Tnc_5^BpWI0T%GPUGgfzwlf>z07=m7 zOcK|9yvUO@7e(blPrHB9p8NEdvdV3fO69E)(&oSUo}~qDqlJ>j`g3hs%>KWnuu=mQR)U^n2 zewG= zbxg-`@um5A!~UT&%EAYp()fS?Br^pU;q1!+KnB= z-V|Z*Nr^xji4@3m&?tLr7;N8~VRwt@b4)dc-BThNe&pR@sgL#5ufO1N{FrREO>~#| zu~C7MbP@GeV^3L2jbm%~SAgH_=P;yQKGzP!3Jhb@X2?uafxLDu_D_-L^^X$CxjUc| zb=8I@CQdVd@=Qpm?Z|OaQD6p2akwo;af+PBU^|pdUTu{2xjKRph(#bwy9HROPiT2* zuzEk{j;Yb2(OKNFG}<$~U@Xjx4#up#sWx-)fgnB6s}bgVg*?%7AcATni9X}{yDTRf zY+>k0Q#MtL3)B&^Q|NE=K{~~2*s&WcqORU!Yfnxyk9g#lQELvK*{z$)*g|=M=YFvgmgEZ92&-h1mHo}9FHrpy2uk9sj3(T;4MQCnMgl;$^V7&0;_4yPv zSNt}}>1+{WLvBNjro&o@3yJj8jPQ$Z-L`9_AUXqog+Gp8r}~xeHEokY)0MQX*s_Dt zx;x$CvSEiHqwrtmN1eaTnMT5U3>Ug^uTLW?oEX{!0~V9>T}`{ZP-e-#MwfERLHEFz zH8{>AL4WJe@nf9WSapD!lAki3gtePyK*{TG z073jSg$L>};#k2UB4A=^+6znb?>J^kMuWbT4B=q9y#5X(JN;3!l6oBHQcXt?ShcuISor zivz!jk608qztiK$%TrcWk@{0+3LcXFODsqi%8@HcWNTj=PxnWeCucZ-kXv#@<6Yrn z|Lx9{oK{f#rrFdxJ;yaJJI+<0G~+n6gI`=mEJ|cmZB3fRKQjhuH0xlT2{n>XHDShJ z+F8h>Wzf!AYa-{4!z)1lFZ9v~D-YGFVJM&HQvz4iZX0B=%&HN-yxut3c#T(3`|C(E zmzjNlh2sYVui#t`(FrFQ`KZIsHdn5@yZWbQC*u`^vd$b%1px>DbWPQTMB-clbVf5D zK7z;;is3N*hUy5n#;@-LpyB_5rwXHRBK&~o>)1c^g@Bl^Q~)dy*`O+8kF`c~5H9kvw}ami4=goBRI8YmrZ?S= zbRZ3)s!ITk0B-k(nS}9%kqH1faLfQ+lGoMtyVcsL^tD9Kt``N1wucBm=v@mBJ)efB z>b+}M)!T>ZQCqg6uNkUTbtq2@N#0aS&TtJGbR~$7&I}ngD~=l1PUM%^e=y7;wg`Q@sq92Gr8iK1{DdE_FMe1eddcX#CV}w^~ZbHV~*cRrV?g36y2_!8dx!eeI)AcgKKJ0qEv4UN{-L;)u zMY1O%TZ>k4D(rvbNmJ&LR!FwHAmIM@hsW-$+I0yMkhfWNz?6Xx7DO*OHmK#a^5Siw zOWa$W(B@=$+&5|`Mnx|J=1_>c9=@bzb;|J*?RJq4Sm-)EMZk2b&9K`J6?e^pflqd% z)RigqG4mRHA&pcs0JJJC;n;^tLBj-%cmDW{`!Vu0_3kSrCrFN&O^?#p>g&mc)`(yFMZ`?A0HKRo-O>Pu3r?|Eb>|g$(Z7>?s}MUS4yG=WFyPV?l{}( zVyus7zrThx1NWBzk?M%?+SL_7#lU}gXrSd9N2o$J;p7OZ{+qdj5)$qGG_*D6l6G`{1L#HMR^T83mW?P)!VLm_;BPO_N zAG%f`{3rx0BF@w0YYw>-i_LEsMBF;^sacH(`5CTZKuFWyvHE-Wa%v=7w z51oLE=xjk1f~;1~#8GQbNG2=k{6k5#^L~QccZy=f697X*m?sFOup?szlFv;oQ%qO| z{Dk<+%YO-t10KPMA>Q#9SJ+FdF}&=2S_apQRXtg$L#&lVex;Xi0YaOmwA1Z1;6xZ$ z1cX8@ycOf~dyBT8{su*_`1I1HHeB2O2%Wx)?%n;$L9ylgKvP5JQ1AmVb_3_E+TlrQ z;No$;2t4`H29Vn7#5r>zDyqx+s>rLH6_aUxC(!)iob)VI$W%h%?%&!lV-#ZcN~yxsyMY-MK_aK&&|z<(QsjGLfE=$V0lf4m01e__+flz%?LlQx2;q?R|Lbc$X?c+H0M zSBQ;3R!FYu#h>o_(_H=CTFJGi%#uDKkvy;1tEDJ~d77i4^{<~c=WOS=zeJb?spTZH zOwNcKdvoY2Y$mc9ZsxzjI+7Ws=Q&%?>D|lQn?8BaU>;|E>Ci7?F5>gjPB!F&N}$#a z5LS?8uDytPvs4;yY`khd^(*1)}~(1 zn?>XjtRQQs)PP{QE4u!fs~$IJQUqCMCL=HS<2jR&G*ML|!zZK)NsRVIQ< zS7(U@Ogj~e?|@y>d%7cu_dg~c!HmoBhVp*fC7Fi*hO4i`K8^(blr zRiHo~zRTW^tuw(NRF|$#kCV%3KxW)((VZz1!&P-Vch;7(LF5*bt?{~49pL%*H zuU0(x*NrdnSl1sL6~QmaNJb-|)Rh7eN3y~)G9NVO_^=BjRejhp<34QoZP1&3f~$u# z1jv0V6b|x0i-4u2^PSTSl|^WFVv^dr^S0>qsmt(Rwgi+DkQl{i4V0<#czoH{ec;a> z?uZ~DT+lrqNYl!tc|kP1){wQ>#kvm*Vz!97ZNC-jBiowqu-a7{TvJENzYm>%w`@ck z0b`s5K|!iuc;FTDT}uP}0z6OlRAhQMuzA*&BN$bXv-l%Ogs8Ip<{{aUpjKR|__SipkS984Fhf62pu?^a8Awie);*TC-OzQvcM10Eqi zL6-gQPdwD$I?EY>*V7e<@IdAuefQ2XF&9s{stDl+sT3>w&1zgkD|kr1CD%AD*X#D_ zFK3a?qVsB6*Y^OvJ3~K#Qj6#>BHpAROcURv`pIIqmrbFK9inv(=k|2VO-1*}7Ug0g zGpZiUYjtTg=_MlwKkyHBsZmiwOr$CKD4SoT_jQ{a1AL$fckR*zN3T6GPe1&V^Yk(C zR7=lPjt4!JyUB=q<}>2bjrCQ4NW>j#RU_zx`Nb_o`9~~Io!rEe8fe#vNZ)yvU-@a6iSG9`pKaV`0KS zgp6~2vI5n_Y%;@O(7E=(hvujl*I{qE^zBrreF}Z^rRnagU64 zUu#PqHg3s%V9)SXRQ%+)o{GbGGq_sdUgh)f-PrJHJ7l57l}Ii_Pe?{4=H#o={Tp#y zml?WR_HgIUbOCYEJ6LgvX1brR^ZDLeKQO*6U08^@vb~`b+-u_vriSy|oN)uHm+_zC z%{H^-_3rAgJod~)ip^z!yQdK~SaZkH(WmdVxFt zp@OwW#GHzq(3Rhgj`pLJleoRke&r;DFJ7OTc+o+?4?D>x18_pg>Y-4eEc8+w$LLKU z{z5Q}8(4SPu7N3ow!s>GQXB*L=!;*F^sS*2@(`tqU5m&1z=?9kYg5}@qMe^MLZSb$ z$}D6tJ^GsuK^4dq&WIdHPYAcp=kN*7$_K{ZIp>Fe215cj-d9XMJ_+o-D9{7^u7XC+ z#KY?7Z@3Q~y0du9CvNuuLW#^-Pz9~eNVkE>Mwb-IXXC+3cr4Q7rAsjV9649ubK8B- z563O`?OCOiuq@^$BFinQ-(h=m>V+SAJAtn$JuIfP{|=IK1`g$OxKq{W3rmFY8|wn@ zb;A`bXu+;X8tLV@BeqqWFR%;bu4SdzoS-PPzy=$?yB~-Fm!E7YX1--SWd3_TUiAu0 z@p>LShich?Ehq}x2_wk;i$=oh4!Z zXsqp?sPY)t|L1$$z0k51M7(d9cVv(_S~jimQDy33;*1Sn5j?WZ@4!fP`6cE?x*CKY zicKlhu8LAavfy!RAzHHugJNiS{Gy5X-Eo)%A;Pp59)H$I10&vroc1>xETMG!S--Gh zRcRQPMULq0Sq4NxPeB($nMnQTYXLYL9VSbZ&k`-DF8Z77p;&*2%oqm|kVx~(4)gg# zlv&rBO{%3a2~QixjFsLVK7n2$zdP0Z&S5P0lOeW~tMDK<%iYIH#C+bJkrk3sJqm!-SjbG0ESWc{V4vgi-{CF{Xo#G;9HKszk9 za!t9C|EmQ+5{UdG-0*5&kO>xB{L9yc5DfVFH8atWqbsM8^CD#=YM{Vp%HLLo= zpZWI8CB`Ttj8f*c8kFZq84Sk?;a6>@t17x(6xvSVen-QKi&17vC7FsvWjxUO^cca7 zV2rhZbi7Eq8w8{Yu=UM@?@J;BewKJKvy-Vr@xYK_@kEQoCd9n^97e2fD0fVm^BQ57 zRLhA8?8&4RQ|)1DjS9ci8{McB=PTmvcjl+GT|Y+iEYz7(Et6DQ-uDn)Uq`Z1UVezm zKfF^J{PlKY_24dfCg2NT1v3YZ(|uVFjY9>k3W11xXc~nSyYEZT!h;G_YiA{A>&{T=dUM@3Cpp%AyKN^*?Y`O=uz<?^`lOz*bmZVuvdw5U()=fkyN2_|y!@o>2e1Z^V zR+%^~d&`ectzzu+{ZNeF)8D;TW>%{O%Fds5ML62hs;y@JB3I;zO|EnVR#ufL7HwUW zZwpBxgnYg!^`PlCICHLiW9rU!Y`61U9=FkzJDI*6ZvfQp%dBP`~#6-?*c+94^e--gTos7WKBGy;O_Tl{l0_l;(Vg)r?Y zWn2YYz~n~0#y>j^5mh-&^a905_CFDYKB;zN0{BL?n0$ zt7h1K5+M;4k16YsUEU>VN2ah^iDAO?W0so23VN&FLC$_3c>Xo(vTM?y%kG`(>r|I#sBr zQ-RZB^`=*yd)=ZH(Ha}`AUTp)=ol9eKFG;|s^h#QRXX36VL47%=UoF$w;E-tBXp0! zMqDVKQ6jrC*?fIG%C}Ymfg;onhZvqR7VoF_oZ8PO-*jDm8cK!Q7knvT!W0$vDb_F6 z+5fPI{=V%=ueTa1xx3Z+czzl|;&l!QDytF)^+8)p3V*{gPwh*04ukhuT&uQg>;~wF zajEQFa_TfSuq`4jGOIVR1?q8Kh{JEp%QuM_Ib1nmUpVt4@uVY`9wBYfl9KL~p6FZ` z>D5;_f5ZstZKvBsx(7KJT0-P4h`z|@9K_mT)bRh!i&9Jd~uzMlO-1MrZn@qnb@jNpuH%1 zZ6lMqkKy%gPWgvpy_Q_L^?29$_>9B?<|E3PV3g`-2TW4|n{alx zb;Y6g?RuPc(V0IFIE~%^Wwg18ZVOkN~OF^+j1rV7N>oM{Gg7({mrF z;fZKJ`qc-aMS&3ELg$cfH>!QccJPoSqK{fV%VSkpe#pj>ihHkvKhrphVNtd+yJ5>> zn>R1-I)%MUW}_71^(MPM|I9u>?bBlDpqgTRs8DtSdM8=bmmT>0fPGFycS(xUkvBy& zs8c#cjJnTxAJO%og49GkB{*rglCLNP{eZ%2m)413DP zHHu1jtsG@q&?~P`#7`k)5NkKaf)&~CV=pGvW@~YBqzR%0uajYs7U|=sg7Wi@OsT!% zQf$}LnG_07_A=)v`t7TLkU%U@!dl!Y^l0KLJ3>LX5lIsKW;pOhy(2fMVvunyU!INk zxU-s^vNyFfk1jf$uwdV5cZNBe^sd%05C8YQ*JU`a@|lXVkrZ}+HOV>T;A)Ql8@52g za`2&+01K*cpVs~Q=T_u!nos`4<^dG2_Ue`G-Ig+ViyS&ZqT1BMe1`!UzTU(9Vv||k zM)R>~tG|k-IFM}YHOeZxcX+?AWwq@$(;bEL#lD{oO!N+dN^KNk{FX`ehNyNphMhRj zMtG;x&1%1m$}iC=%bVMj2kAuJU6Hy@XZYA*DWyy$^h~5g9kd z)ow?@;@wI-gsJ9>`@)yL$Umo5way5$VYJ5=~;J1~orRHdr;e5f$3Ajv`2=Z(T`?Paf zg$^uCOT@q>H2~(?62Hi$s-nZ1)lDn}wO7CCt&s705{Gh>O_m$$p;_^FcaMR*d$d?L z_*+f-NC=)NPCply%l<4;sdva^)#Z?$Ez=z+5V?;lR|{~E{T=VTX)>#t)pEesjSgr3 zB!*_s6EVltKCNglVg(C}TdeyFz_Yd1$$3M(vg5ZyAcWe`$AH}rV+HT*e6}`tX3|^PksR^5OZL=~t7O9+MKN^FWbO42&1Nr1~ zvd`75eDiZDKfz-TUDIm5<)ia@MV@yo@I`&|SwrpM4C^8ezok&phCWUWaxhk;vbC&_ z8J8S!Tv`^bvz_q2br#`Vy}`E*;Y7bFvmZLHUGO%orlu|k4%OZO;W<-wcWRY73E{#aqAqm zIP5(c2AwpN>5OhORUitOQt1RRYGxmfi>B8F51-h~FrNq}(rIU>=(CJEFYEb!HHW!o zwj73tNFQr;^vV{hDxMm}+-0X1jXd5+(F$=6th5>G6d&-pHb$MlsbuUaSV8wfCO~}x z)%K?99L)D({suTu7dK?-A@hs_4oR?g(R4|~-0f|P3ix*u=+UsJPvN}l>TkX|reV!h z!KEXG>$^%ATpO6(1V*ZfBu!zz6y?nRLXA0~tE`fKm}CJ*Su(nv?;(`>^{Y)1>-3S7 z(WG{H7JK9T`QQenmVB4xZ_Q?4!8!@d*VKYV2Ygn^HF0r@znAKKWL^DqqKrF`yrM*Y zoWnK<-{$#w`r4j0TZ|%+Qan8%O!z)TOE#%1#;spgv?^FX&&y(jJAKDO1@blTjss)M z@ge7;DB}j?xjR6~N>j=9=fB=MoRRMJ z=H5tNvYnAteE3z65=a~5`Gn;QRc~rLA>_pl0>$7xSNk#n_%ZjYH@$Xjd?j1@6j#^Z zd_S`F2-y;z^0Nh-n40Xrookxx)_vdt_PN7+4gPiu)Yjb#GC1jC(}t4apOvk;OYGe` z*J)z!m5_e+>90;fkTx70GPyOmL<*Z_#M3K7LI)4w>u^whWU!kWi!%P*1V^~%wK4)O zEQhel_@fA=k>z1k%P8v-3yAvWi&40*E#D)HY_=1wuH~1nQAAWy^KJ)WtuY~+X}M;9 zw^E2}F`e8`b-}UpLS0Hb?Ew!i!=mSF2^3`H(>6ho=m10Bg=f7dBf}tfPBLz!!g%CL z9{an$J)l8qlaHm%chY+oH=7V!trT7KLsp5&Yik|oR~M$1o>){uu>Iv8-7p=|X3~Cg zaXR4)`S8A`vOTJ3+BIALz=g zMt8O`Ugg1R@f%<&F@c zF_;oB{#z+fCQN#p%`hi!v?d`9b)?6#7qF`;+L4+whxDTs&bHLE zr1j)L;;pqqX1K|gL8j6O|l) zai+~9nN-x@eMMAiv}!GK?MI>lQEe~_yCK+`RN|4RdtcAD@O<=DEH3|9zR>o=sl@Yc zh$8(r9RhgoyC}UMb2uk zH9z3kT9wk#Y>Dx-&Va^Hn?dP*uUq{k#1-p_7?rCp;zc@)UW5;pSSVI{_6h{+J;!a% z*GHlP3!c+84@u;w+Y1((9l*u$iivDdD7xwUTSk8(=2((<5iiXV(OFwg`#ilcTm7I) z)r5uEDi$->G-VDg`NDnp$n^CpG{xDBTDvSq;lpV9A*;#2VJ!xp13$GNctxT%50B2~ zh=H>mKi10kD-JoZ`PzG%;vtKBNCmUv+t!zMhUe3AHrO|3MZAMc&?sp8BGJ&vtjNIruQ_JGbjjTlA@TY=ePfA4TShvu>) zbNnI?qNJ`?1Rg*(J!~usl*7;(SK&alVqCxSDr=9I?SyY>*IWs3FRQxH?ft>JzZ4Oc|NZ@O@7&~-ZVS;A%(qw)K^AGuxI=a;v z^CkLLG`Cl8VRL=HYBaX7pomXHtqP&N%fwdyFcsUh>z}8;^H;M#h!G1#J9Y75x-R#` zd0UmVswh$T@e#k3J)CPeAEj~_E)?_!djhPymtX9}X^n@tVaRq6*Ud~8O+@^Yi0Ys$ z`QC#kd#+Bvrl)&po~*F>Y2>5%OM7ygYe9Lm zcu+ak-V$DIAr(I4uL@3{7O0k|u9ZIgTjIcdrwdgep_aiM>FX8(&nbtc$TuFMyO~+N zK7R0%xk5%RCEvh;v+(@#kGo?fxv48oMgKZL>f9eO2cT660{OG#8e{;DTjwO`n=Fkh<7wC(=TcI?f3y6Po)t0kmNrVT{{)^3GM%To3gEDJ{RR+CUS- zixcZQgk(OXT7f%0Heqxavg9wQJO)Td z%WM89AayF4gN#f@e~PB{mI6xN*=L{PCowj#FIMkwx@I6v=|bIBs`)E4xJUX~`u3)$ z4wMKjl4&1!a8_RXar=OpvpL6V-LR90hR%m-GuI2MbBgsE+B-58>lG0Lm z%wQh1{?P1LU`*-@Bk)vsngsNwSQ3k&V-o1g7*9A7A>L$rrW^+wscl>B7qFc2?ToW~ zfwgt9w>RTovLBPAsx0$F(Mx-zT%|7>T*a-`P*rUUhVnly>*RyXv-v8xG=s^& zKLlv$Gn(64?f`$@R+?bN9Duulw2uJ;Um%+J5p$|dh3-!$T)uCYHi)t%2K%Jrx9Qtl z^bnoqp}!8N+WZgHaYf_VdJ_Yy3dCIgz@N`|Z={>t%4fJ$L9V#|l*+(NCURgbEqOt< zgDnQQpr$1~De*-sm*i^Pkp&O`SibeoP`4Z~^N0=B17Hr#p*!i?ew{EXDf*{OSwRW< zIz=ar2y9zT!wMqJ=-{6d$ZQ12EBhg555|QMDTuhKL#y4RLAv!X>uC!ec=h>rflsHb z;ORnGK?wjNQw+o{h=tZ@i|&?}XlBPnR<`uh)Y`x?KK&jNHSMVRo=bHyrUlIw(t1OY z_;7t_d~)SX2hnm{UX=sNe66ns&ntzQ^s4@R9HZ`%ae$ZeC4h-y+>?V|nbzEWipU2w z4>?Eh>9&PWRHNh>e7XGCE9sJd>W#1c&z~H zbFTArc}W+$$nrsqwq4p?dalSMr&#Si9Z)HGIXM^cjYK&=Mp1Vuc3izKZg5epUDd!Y z$t{U&eA1qI*4}oFn{d0dXlw_WF{~opQYx_`hdz(l`^58qhM+0ec{;JFNH$@h zO%L7yr&}!&3RD+LDSkX1cBnmzLZ0~g4Y|o#7?0Bvw36elpdpJv^1@YBajiy6F%{g6 zw)cS2vt{Z-FZ$r>Ughw$Q|Z#;CS5$Rh;+BEx9W&5D`FL(_`6WC{AugTt&Ut@;+6yS z!NH<>aX9=4i=mY`PuX@p;I$u3dwy+pXY{q9*BI(_<+9*pDdLGKku4yhOVgsT_mv$4a^CVL6&qxriSenja3(K857Vw2MK&XC^<1}`?KJ(r=-V{YQ z+@;>BO+YdJom(+)O8FU+!kG%}8{)=Wuv$x;t!_ssjv^lNr&(@k-oou18cPIB>M`1* zl6V?*o)!3O8a$^$%!F=!f~V5h>)y`>ORH@$aL8=P2P z=b=wtOtcgEujB!^`e5ImzD90_YkVvZ_%uUvS578$D;J(PX49CwLG`2L9mj5DP zO!Vvml10VW77N(yqb0W#;u08=emk=m*FQM291on2Ch;N&=SaG>4B7W!*vv!vqBgLv zh#UBl(<$-AYC1qMYf)TI82>kns{k1xNt+GqJGuI^iI7C-l;LcI8T81=c_%a+=o{HRg?n+0+XPAsm1#)dtTcXPyp}T! z6)6~Hn3e>?SYU~aG5+0rwj6aDy?(%m%13(wF=CrEM@L*ks&7(b-|0;S$&D{3AMs4D-u=p3jovBNTiKpZ zpoH3M2)dxqzy0v5+2bvM%!SEHXDPw*xms?O92ka5OW%l(w-9oE3^>>Ij3M1^_-LN$ zp7}J=+9{IRT9fmNj!4`q{%q#&q+c-fLR9hX`A6n*F%t4=24o3P@_#o&1$**hRp#y0 z+f_0U4)*AeR2wY)L*;R;WP3tAWjgXAc)| zRTtbsc`7+&i$VBeZpGy(7)Qq3K~~PCn9aeK3r>jbBB!SVtr!tr;EO#v#$pNk4#%|E z__wr`##g_DY%`ml-{ivGlkMf(0dqAbe=R3rfAv>bRS02s|LM0?sf9KNo%;K7GG0v1 zk09Ue?!Fz?!UH^+Z>CTY%cRpQwGl5k0i4d@(9SO(A^t}caGS^`Fj{=45)pInlz{bd zHPExeKe@!fN8o!(rOO8|VMJ09^vy)Vk)}Q-e@)|TlZ9M8G7j`U!im!ef9bF4f$hj! zOGL9(V^?(|4oXZInkxM$0w&juwZ1pGRx*QbsWc~#nP+GE!i~s^5|og zTo>3w8gC}N<}k!tA)h6|j%~F#wvqkzD+zZP`*r&exT9S@OMS$?r64jb6qihVq0f0< z$dVnE2c9L7SG|x?eD4{pyuCyuC4bcT{m-${(R}iV*REy4BU>;n?*%On{d#1kk3j_e zE!+WO>?YguO_>`{^qCSg_*H#t)Tb@DU*&a|&Q7$Qp6YcJ{e~`bu%+q_nC4c$pCAmH-iN3W z^YK=|C}CxCX-o?TXKK7H{eKWnrIefu!$NHz&E~IZfOtRn3;wyrQsbETg1$o@DQgr2 z&75hrmlzf-&!26BDwgk`c9fKSmhE!Zws5i(pN(P;0}2sthobW(q{By|j*fCkV{eb3 zNGO^rkl<+#146OTFNzp61ql4V9EVp9si-_YG_HCm_hf{1B>I+rN<``Rd3-w7Eg8Ny zYGtP>;BXL5duDjIjNNysaLlrIjcc{E`O*72F-sfu8&7&Gd^F(G0cyiD6lQYK^}E6S zuN1rr3_E`$z?3NBi}U?_wfs&_mBftzP-&pvZ5d?VWJwNgAu);eF`c!WW}0$ZyubV0 zcvF`9Ow~dl(DvfJZNLVv_Ld%2mJ(+rK@eMiaUbn5-iXX~O ztRq*Z`@72lC(K07J3FOBe0ou@EHll)!kZ1;=QcI2csUSURFROj?Z&Bs+IF%^6&F<2 zco?Nq{h1O;#6}lS-h}@ZIlOoN`*}YT5YNA~=ByCkQ`!#jt>Ia;ID?Zi18UN+lQg3#}(wmJh&Td$*mFk zOGJ&pAh>eixYx`IT+LVsr8@DzZa3-l z38^|6Ugx5+yZs7lj1u2z2LY;;B=|x>J*(#66Bg`WoKacUQZ9UoC$8LrDKb4fGtIWt z37coKzGTx|OLU=$xA*;|YJUA5oj$>yMsgX0>%vdx9iqJw zH^-E$zq329ewzS92QqlbG$Pbr+ z*XK+F+_F(kes)S)COxY`(O<&x$|TK*vkrmbC!Y&Wb$)aO8Hm}{! z17dPc@l4BMt51h&j-duagY{5?Mg$-NQpJMk}J1>h>A z4zKnt-@Y|uW8x~@BBZul36i(5DUUn{D*>_rS#Gt^l+z8iM#oUzMvB&!zX-f(2g~%CDGpAnw)wza?!tWk z@p)%##i?6ljIVjLVfxLGZwV}ItcLluUoLWJu$t3L@#I{o#h-KQ7vzu6ftictiwiOjDjq2 zyh`E<^-8|Qq1bcD&;qiPefs*M>@}Tv;(Ecc0P5cc8xC+#tJq$(<619cTS8Hs^$Ijq zDEZtzD*e^EOh4`RA9VscjPe6%%uuvg2iXIq=d<&LcC+`x-cJXA`iFT-LXtBE=bHHC zRWjNwS@m3-l2_qg=)RZuCipVn#xGkLrDSeg^>4ot1OX69li7qaa9JPyLo95#+^FI1 zqhufrCXDF-6xe8(MdmA_DbKLVbpJ?qgTe;EOMlu(w4&dz@ct)W( z$I|5JLBjbY`ml*{%8LGGFIo1t9~G%Hrod-xHw{Ov)@%Fo=0eA7-k7~$#@4;s33PnTkNf&Cp)4q9v8bL$Nef3j&zM6gKP$Ymn%ia;c1Mu@JY zfZzK_lvP(=IKOtI=MvJ6q#U_uR&(|qgkAL*eK&n(PgG;4PHDdV^2}3Bf44=`hr_b7 zKe9$}thwq#(K|%T?m6K~zG(k|Rsb+CApJQ{arWsNJ%}g3$*<4ze045HjNzC{`@r26=J9nMs0XqIkvH+n~PK&bFU8ID-^CAMTGD4ukkDv%HYv=+~VSlbboN zkJb7;+A5%$XInUx`$-L(BqjPV;nx$$eIi&DI-5UMs28-_C?Ep)o3Ni0ZAg|69JZn! z>1Qi${zl7F3-{MPHTru5wx260-Ra`Q-c!$!!SM2`@NG}dyCJa}mj3R1Jr$7Kf*ZG` z_t!+F4+26X@f7#b&v%F1E08CnczIvqij%n?3%Bf%?&OOzXWq{{6(JURZB^7-A{Qol z!^fMg!N`dp0d0+)Ho+PsEE>qjFnPP#&jlvMwt$nD?|Kk1X`iH&%*X4S_^cc={c4V| zrxFj_LvVpQkbETHV;kn1Ry*!9JbB#6Dt(rvd8HQF_sF_4F{biQIXbuq{#vZe4LheG zA+DyuVa)AUqnA&;zc)aYrENb^94n*6ga+wQlU{gXz&NF$a>R`X**b*i72a{^7& zsR=*(z*&;caO{Tx6xwq}nA$eOJnp ze3^0=k#{Sal?#pzY@2%pAB0t%P-rAx_1kme=t&UqgU75tjbg%TcE-&=e4GPLirdW< zwfW!GepS&Oo>QA1G6cIFPp_)-@HF_g)U^BGH>vHCkAvGREpzZU=DCch|8dtGT91q@ z`lEW&|1?mTA>T!e)ZW=K{g=q<=9^26$xfkqx?#R}5*pTu6%uT4@dL^~#=M>0x$;JB z&piH-R_M;{c6=0 zjf{S}Ixf5(H((lJPG2vlUfG528nwz4k{?$)ZQO4;tlf4~mHD+p>O{?34SRfrh}(1# zf34SjCJ4MEY|FfTxSX(9o2<~A*t@BsmDffhZd)fL{?ObS&wFWKRt<>dZk$=1yl=OT zgvk{6Kzq^j4pVYoOomU55qQvgtx06qksi9FK?w5rC=6CV5VZ12f!U@0| z)PORexLmPSoBprv;!j3zuZZw6GDO{LMgU`+eY>m1F*^b9^PJ_I)rL1W%Bac&z%d2- z$N+g5_n~%n#(sO!rG26wjB$l!r_T9F==f61a-kcn66b<626sNdGn!06^t5x%R~ z9C*!Hrc9~ZNZ!sbH1|cZb+xIX;v6MOibVID>aNGiMH{G@!0I^7icfPSqxO$+50@3xcZI{1g&xFVq5HhyM;UXR$uB#4MCZ21iPcwZ)JI-@3YKX%`Ex-9G zw>jcze@5gF)NVtMPq-Q!*A#0fJ#olhs{p9lHAIOvYO#^CcKGcYrAg#8z%}tPII3W! zfbEdacfUEU+4kzR`o!iiz4``WLPfP~DFJR~8Xpf6RsK47%uWK@h}KE=#QAdi;f&c4 z-huyh>pBPwTww=UeADmc>yl5DXYX76&JnJ4_D1IkvFqX8)IIRu$+QtfwtvtanA3CL zr&e;v5}95nX}`EP%5|sfW}ANd$FT&BtiSYuG8v=}fV8$#FMkG*ZK-}!x6~O<)hGd8 z$Gl8Yw$)STIr_A@XQh_S@ngp#t~7_gV1fiwlg*J3!|tq9;>+w#;^mr-OhPHRcbAUl z7x_{%J{Sr}=LNR@V@%%58gB+KbDao=3@pU@9jw3O#=4z*3N?Nq0G#EYu212L`o z`!%#n*8{n9nB@YdONBZkxMrXR5GQ;;7JLP~#|2<|LA~_>&0+$WpxG=6{y)Ol+ zM8=igdoyAJT7j9z0imr6zt7;z3Gcmk0QtFCwGxkkAbfN*|Aff=MvDln{N^+|H!#TsTS`2m(k+vLmKfVy=kMTQS4GVJXW4l@i^nnJG zq`_POjN0_4#hxdScKw?j>Uw5%10#O?hq3=;*kzYt}v>AOBn?>s%rNhCWYV8PR?@q%Sg zrgv=geRQt?Ox6^z(^xMD@^e7sw&(z{S&Lffti4xD$=kqJ-lT0tB7HeOz58FSTWuj( z5%ekXVZPegLIoRNfZ;|N%sN%TS2C{l&!~I`iR?Iw0D%1UaJzFV=zh)`0C~}r5Bf%5 zNDd-BUHpTrZ}jEj#_BUofkhEm(iWnBs6;TlgW6Fu&-17}J@0-LqHco=uUTuhJJ&yK zGe4}dvKbg}2Ns8Ib@4&VTom&NeTn2d4Q`W^JcuoX`X4MGh_l2L0S}go-FK6`@=nGo zkHCsN6U40KHFKPue^1By^cUciJPckxv?KWQBqDnLN7g(!k`Lce8($E(8xVf@x>}b= z5us`kb+px_p$x2%tW2I`YBt++09WU`^F~R?VI$>Rb4}>Z7i4i2dB!|mJN1@A|Jk{@ z9%RrMHN2eG*A)#=uOYVBR!c-N3za=#z&%f5b_N77`>%u1J1@BAo?LTedZ?os40vU3 zP)Dn8hu};fZV23-##rq_Mo$H$J4uC!j~|eT-6-MiJHWe`>jw1}uZIEsB_nI;1|4)e z)4&InV)zMZ;7kx;#cu|%7QG%W2@ak1S>HsR_P(0{U*SPZa5u{%s(w$ZCMKlLJSbCVxep&;LoqV zvo-T|x#*wp$xQEXqKy}&P=vHthw$G2K(h@t3X8)DcnUla?s6szXiM4Ki^a0y@<_VA8N!SL>GTuLfH5 zs<-V{<&jITSj@jH{>RqQXwPHYGOdKNdnd1cmEdzTBFN9@KvLgyO%QU!Z@k*9`d;gf z?YPX+vAH$6m_Bi(Q7Yf}3tcazmDlB`UdbHHy;l*6c*A-3D^#Nytfp-9;H#f!n zM;%)>du>i57U^AUsT4S5^!|`|+PUk3S1C{%aC7{LOxY61za=%D?*VN7l0VH)7c(O! zb}Fs~!%n8ZbyvMiPfqJ2s1*K&u37tKcq>3lxZC_*XlLW6x0Jw2&d-TsmMK5FSVS^k@-DGpAU(N=dr!^9SMN^RVvph{dW98Ch+nPF|x5H zMx<7_ji%6%Yr=FKy3k&8ZCXc$SsQ=Xy3S|5h+@L1vG*=IF0xsHm=AbU6GmHZBk51fLo-o_ zSX+dg_igJrs|6b}GRx*o^3W8x7S8;F>t{gJ=ry(%mP~&tN29_QM7(x9u#Oh25-y2u zO}PhmCBii<-{dHL#@}h5O*NTMm>v92`Gl?#pKUB{cbVeKZV2)&z|FooraIYkO{y2? zs2l^-NN+IsaQ29d?F=UVWME2bzcfjAXvAW`r6a@X&B=1(>XGd3l;Mj*H`k~%5@CYL zu>DVyguLY28P4>Z9m1#26tmrr{~K7k%Vide&pKC+WEOy?57>BOdzsIVqqR_BS8b@Z zKa&t39(D&SDr;P-*c$4#b^*~OuKqYk0LO@8Xv2Ap1n^@0A((ja1?89X&+p=St(d(! ziH1?%*um>DId)(CxTXzKjejGRBB&xo_$~|YJSPHsQFhkp$7jPMhEbNsJ3?_q<1ybH zx*ylN-mMqj!!qMum~K=5je)^2RAnXoo(HX}xudmM`&tkqOr0Hov0IZS4tYA7FDQOG_12l@sKdGGAEc~~|&9+^y^U|;{_Q#G*Pm5Jl%^guBwKsjv?ohZ;j{XA3{eD0)A#I|dR(1jG%5mpqN>8X&^{)3ruI(quPJ64=D)}~B{`z$P zx0}L%&Kse%j85k7J#}X-l3s(x&3Zt`T67TIr_>TZ5bzzyQW!B^YDA5AuU{S_%pp)A z5F<&^;zkOXcp^7aCjAu{`-s_b_Y>>)E}@||E=JADec$rqI4O+1jPcYQLkM8n4atY| zS9d=CS><@$4`8@0aGLaQ73;U3c^4Q17?>r|g zx_(HN2;j16gN?(_fUHwB7hm4!J?VN2V9_($@f0W2c11X8Sak>bkH){(IHJ)Wf3TUO zxHxwOlq{wY#1Y+1tmN>QanZKPdqq5eA0!TZMLc3@za=6+_~3UCFZLf+UFr?{+yG!$j>cpC*->ls1Z><2aE4Guz z6?TzmS6XsL=SeC`3LxEHSW9wY)UWs_6U_<5l-Q4C)bXEl)a{~6TyrJ2XBdA*VtoqV zY`#GJe3vd27^R0Cis+;Uu466s@H5i*>LC*c&R3+sD^Z&P{K4VI0|H6G@v)L~e&UC#jqyJY8meuViA?){5eQoPq-0wxQWMiQ)jz&vd->&jpMNKx zl8wCZ_oxxk3Af!h$|y(l@H5MEEf!_16?f-PJNU>0*eQ|i*Mye+U4-`(!!}_{lR!Z3 z`b992l&T#Y{u|ZsUC$kb)YjItz1=SHTGx>q{$(glX(eV13dFiN|I(HGL$=lC_Y#YK zqR&B&qzcWtSYx$}lmDu42)L4@=Cj)I$m<10STe9YJCd8Su{DWibS5kMYMr7au=cjR zYI`|>BVvP?>f5)~X4i};Niy{}qg{HM?4H0%)4q>YrJ7e(F9r~)N&%)XU_>{V zl=-vRYZM8k<=s%;vMj>+HY8SMf(}GFopn%do5_9{faV=v9z|5q6PmL7>yVDkfxx zP3K+?KSy85TcN8q$o&yzlcM?jbq*3H(^#a@LZr{#57WoM1&yd9Cq$Fm|5+6VoBIHT zXeiY=pGQ@pGW-oj|FcOqcYvKv2rq@(5)ifQ0-F(v^7a@FEg6sDF)b&tyn&_WX%kP?#2q@x}`MJ5TXJ-UVmXOvM8BPNHC_WtkDme!iUj&k+X(PXk8G zdv<+SG>>cb{}q2p$+L*(H3gMq`m_B5xAn9*!z)d+wjkXeN<;W| zRQKvSeSJ+@K|v_iL6M!*Z(5!|=>8YjVtZ}Dam(}_BEfQK=nLPg2Z8DZTc76B)7|01 z)h*}Aw$nFFieNnN*T9nvj!&qe8>h$DcF%O={pr8FL!s^xgA7qff0``Jo|U=FJPtf7 zrc=3lcYPIpX7K2()8sawQ(T-_4s9&Tp9Us#Sk?+J+=)q4?qH5~ACpQ^z^vLyn<}xS`DL9A_;Et!q7(mo8~RC2;>-@~ip^MlwP!Jk{kwq@KS(Hm?@A ztb^heC^&ke<0cs5{0$7v?^P*N$=)TCC$TRA3q>kj8IPz#aD0ADJ0Z;>4RhTq)ONfD zI?>B24ZYFy(}gelxo8nrY{pr`a73SZ*?d;Nl$$#ep0q)e16}~V-Qcv@FdV$WUTL0)udZxs^sw%uSZg35Q(%R*~TbS)Ix1So6M)F3W5 zi!PzBJ7S^)u{SQhNX2FhcU})$G=Asv8}*#Wt85}jCahj!{0n1JoV=v^p@?gJA4P7W zVndl?orHT@HM75p%0x{Thk5GtA7{Z zz4{b2RfcXMRtv2fLV@`ue&}L;Tlq-)8$|TcuS|CrZ-r4>S+dq*kCSG@X!>8zdQ>aO zYZY`)srZMsQ1!U3%NOk+JZ1G;9foy?4}`7=v)7G`iMEVSam0tJlFF+;OEhFV4!5O# zHgcI`(TB^5Jok-vudt7jKl2E_dX4t5^WO@RR9c-NDWm7|+U0TD{{`mKy6XH1*B{db z)puw5K~GI6coZ>o%n%LfQg{Z5NxTQ+GhebQZ(=@3)g;^9bNU64!0KU$B@~swn`0>m znMjxR1yT3J*{Au%Wu$k!;W=EEj?b5xcUWqHBkJi>G}kAJJME`MZ7yB%#l^+BRxt0F zUzy)U0V(n63F0^-hWv$f*yFLa8F-^Dia?Vb_46YVj!$?pnf~w94btzQzt{(3GKi|k zK5BDETHgP-as62INwbpEoy8K4*tf#*E~f2yfWo>Jbg7oCY3Db$-agP7N$8h&- zr#05_Vxiv(A7-1j7Vdw9T`IMWsaP!JBl{LxTHV-S*XZ6&yd)nLFiV}&U-MbX|L4Gw zX};t7OdO66_FubL4P0yF9!ZB=WS8PSjHJ9#fxtnFE z5-AZe6ALP5{dosj29K=I+DEH<#4I8<3^UM6kS;P49FIstTox))ZQWwMY3adGhJvHg zWtca8kW3CUnEElk&R5@L)F~|so{hGKd8e(FE&!-N&PDi(;3ACZhVq~vl8zT0gw9QC z9DmJNTDcGb*Egp60WZmmk!!vLx?T)H(x$MSVk4~;`?{4Zp9Vv870tl@UIl7y$w#BR zrFv2F6YAqbbu|Pd^q(whw+jdJSN(ir^=&1*E}Hyzg3F=d6Tkizd~GN-a=@loZ)j-O z?{;+@SgL})u(2cGm3-5GVD-;Au7i+t3~3O=o_a2bm#|&>xm=GeZ50TeltzX5v6_fy zs<9Waeh}1WpQ$E!VRb5yO1F%m>>F4V%u}P}(RTAKqfHMhugHZ}#jETu;LzMV)JvTl zu}{N=Tteh39Fb!|56AOkXv0)!FacM4SRKB1br(aA8M?DY;EdBy=az^=oFrBB=6%5` zn`?!-&qP(ayQuY=(%J|8mIid76hT~!nSLN>)Gw^09`}CST;h0K!dekOr~9MaE^fb{ zJ*EL9^~K6FI`{B+f5K=y#0hdGkV*Fl^zcD)_Oj$IiabB0SAtM0YbxIY=45=-z=`&K z_qfZx{Y*ffeGoZ+^CVeBP*8Yt7g-i6mtlUFLsNTGYq4#zxRM46(Ky?G(f)i+wiAWS z7^V3HvFmp!?>;J?M@0jnATs*SQhxqd2=k#BiPP7`7emOD|7E@P70djW1Kt8$mlHaR z?qUV%DOlF~-s<&^^YuO-qbEz!p-v{+c^(jXNVIRR?k;|IZdPKWGNG)_^3~Hpcj~f- zaTN-~&-yW)t}WEy0NA5Nc)z{07==oPBKdZ3CB~%Obn4w}tnyX&M?V|u>2;~Ij1MwfL?!orb{+5+T3Rk8WAXHU5Klkx09@~zxgSzei(E?!i+%yF=uZv zaK1R+1M6XjTb#MzTcDih1Jzu@LWk)*Vu|p!X;qUnqzx#Lfg+KoJC*WT?OLIv-Wu<0 z+E4unfuw^;e|ry(1S2kGQ_+E0q|TKh!*OE$)oEhtu+BP#AitOVz})9POKVhO{>(7NUYUSd!DD05@VBHhQhz^`m0yE+os}IOHC~O znoXBX)_KPDMhEBcfCDr8fJMKjYE?cx)|h>QCbOSj)KqrcMn5Y%TXz9td-19;kvG8Z zZKhNLM@d6BZ%5az<4FbZ075}cpY0j;anrbW#d%ouI#2^P$2@n_Lbb_Z4O&5(?LFI4 z=_5<_{2Adp`?qd!HsC6>ikFx<0_FTcy~M9Tz?LRPox2-)Pz^wfilnT8gBhl zb0BjKF+VWeT#v~b!4`WFhrYM`C-0FnRn{EW1jZ39e0q>!%(Nlth3xg_eS*tFqiI*hA8BMtAhhdlt9s0BZftv^q9p^hmu>pGz07 z;Jy{#ULRjpUw2(o0^{*phHwwMq2goKk2!OHSK1|z;!RL_Z8lT=qWSs85WeFIAe&)o zm)%7&TKie(wN z?o00amS#mj6G7XR`6`mmIyl_=t==Q;4U=_5xzaW=qtW zh-q$(=3RrA1kEtNH(Z471OItutHk@A3jt4IxvYAC$v~IwmBe-zehP}%`-wI=hiRv7ra=#%u~ zX7=eshBmJtUO7W?3@yoP;V8=Q+3X5qO{MZY03Wq6|2=9^sHbA4AK!=ptY5(a67{hP z^`c7+$jE+Od}u$3&s^@JT&hrRm12HITPihnXR!~DPV`TVxg8J0$f;|Ezrj0>Z@ER) zUqYOsjTNmBT{`J!Uz(@JlDj=Ke-qmx!tQsJkwDnV?SeShJ#aEO(zN(oc zZ-F0{ac^gklt0PP=;Ve86ujXD4GpGdefTy^_%LE%^X%xC(0fLjY9-R!{WVHVxpn9)O~i*=m&psbS^5$#)Wik8lfY7;`CA72 zWg_@F7lcdu7yAL$n$q68Vhy8O9t)iI<|=#V$IqC_hqAo&uG1u5*FB|Qj`^Dz({gCp zTQ6xB1nmSM5)H>DfBPr!6)=Z=4^XTo$qOV|XXV`ZsK;n3euvH$5;JpA^WkJ$aWNCR z;Wl!J;<|y&{)geE8=4!QE14FVDAGVF1YETg5`avR9=N3^V{*`zuWX^3IXLn*iyFB# zp~9f=1k}8&Tk;AyqVpg`GjC<%4XpTv436w8RhtVuBx`&D&~`n#@3j&|a*&#y@FykJl9LnaCFT|X~p`-dRz4Vv1wC_>)>gi)$^RtKM(#ms>(PQ+| z@SN7uubk-L8LEDwYLc5_u0a{ofu%(k%p_qYyiwMDFP!_x<8SR-^&|V*bFRW0?V8j}8rdjq(wKtmV)(qdu)eA%$k3k2+_ zc3qJ)LmXyUSNS`$wV40pNtg>`yXNvEeH)Bou)Ga9M%u4yVl7?m;IAOWgm#X?&jsSkI;RK|eQPrC5^ zn0~@8vg2sqH>=q1B_ zGYGaDjEf09+XJ|}VU{k1b^DHje$2uK0o9h2ZxiZ#+g`VS%P}Hit|At{Ls#s|UgBb8l-O?@3)+LWTIRbXJ*$X?aQ(7BeBcKl} z?r6;ZcY}^fFe*zO3TCN$I_Dw=|xXD;F zX!0a?XRg@{=YH1qcV@Dflcbo1lT{Sc_NMv?ZTTC=$DYP{R#TQ>&J$sD(5b+NmZtno z`W$6}rkLikK+L9i{nsl(S!c8JsEy7Fx&*k8nl4ykc%Lq!LvD`e5dbl<F@ z8RZb8x0-1)O?Dj*^xXHv(w`hmKkpzB(Di|v#_33i>KW)34(M~H-i9ykG!d|Fgn={P z2DI{+W~g&J^Qwpn!~fFA2a%J8(4MMQWaIzYQycM_mDKr!e03xI1b2MN3l7-Fe^i4J zu)`ycU;h}QxTftm#kkUL@ojzXpP)cuy436oD_{MNSsu|(H*l^7zYK)GH-f7faCLW-*z5Q@Aa!lsPp|!Jj^b*I1mvAxy(3*v<4-{)m zT|>e_P(3c>zGnTKAmDv|*lU7hf~RVunj_|fzT0F`%8e(^=SoqxQw-&!jA6r zh20dey&-IAt?(~8R5&hA!N(=(rK#uc4itgCnSh}Y?g>mn@e1`6V_bq-X$4%GCWett z*i|udh47U5t%8og)jdGNv`1ho*JGI$HJA$^ZhE9k z#M4AWto`1CJsE&ORtCq6am}XEQ5Z{qF%)TYhj~A1>ffemBrRc|OK% z|BXmzW0-84I^fTdeuJb9!``LCq60?#v$%_Y4P$&6x}31o@+kc*W12qCE1A!NzkbmO z=~UxJ;g9@`T(llyM*x}^ukq2JdWi+vz7Tl_EsMwIAQ*%Eg<0U-%*ov716Y}*?eI`# z+Wc9%2KoHnD|ou3+Xv664eo20$@bBAgJrpXp;{qcFoYMJ&}JDC_-npR8*DWuohQ1M&vYceR$-~;X8nPz;fcn4c5F~!t@-RsxWlBogK4}1yVP5o0-O7v z`e(1hXK@_gL|Z`@0lBCO9;jwTj2HaH#eK+GQ*GidzIdIl74iZa)fn{|u21 zL${!2num!S02zs6?Ye({)|%F_SRWK>C^ssiR*1oRHYIId?d#+#_l}1o>!1I+^0AGTz5KCOUp5eaB1=*;-LTar-SrP`ALm;-S`FEPuNvyy^^9nFIa_p9&9gbu0+g0}$cpdCb1wP13@(`2z!{t?zw?GZCxp5kct z_%Wi>yQtZ7egUq**jYFX{cpKx^y7U*Av8*N@_<~!j$}ert%(_r74cD8f@tyS7fX2* zh@+I>@e8WT*eLTMwlWZCZPT0l5%A@zy&_urk~-7dq^2Bjs)%Oy0{^8K+~GNUBrv4J zNKI_;9g)NM)S~^g7I2Bd)W6L#q)7fqa^2Gm8Za+r0VB^w#cT@t7GiA z$ks#M zvr#>|5Xwe~?J`$z31P12`G%omN(a5rA_q{pz0{5yaeBWW^|!| z>YYTytfgwR(q&~go$sO9=z<@M+3OxG*&3-Zaep2y>9u5S$Q+>B}t_(o>Q(6#a0CF@+HQ7WfDbb|npBKII+j(!A{%|$zZ z8y-BSb+kd5DD^D%(lOG#AH>v2?8UYRo(y39tq2Nz3vTVhV=m&ySjT>UwSVpWxrX)cd7`<>Unh2Ij+lPB898fc2kyaG(ua z-)-^vG+77NrQ5mMInZzv*+sdAz65i*7*Cy&Jm7S^u?wzCt4R%R+RVdwjg8lM}mOCc0mL|EHRo8c6@h$X0*syTK0c`}L^DJmW84>NFc| zbo9@+M>I`L3efcNe`BhsByMhR6Q4W_;LYLm>`;gng(2`lh_FY@DutC6k>A7ab|A9R zc9h_xY7d2cF3S#*puoWWA?&8iFYd;k^7qQ{k2hx0lNE$;@qJ9(XPX)Sq_p8j79NS~ z*?!)p+}>;f-xsXc)|6ZaS?IzF^;Tljs`CZUYD?D}R!ceW)l(d6`uoGf`0xeZ&SCa! zAd~TvGmwe|1QBM*-;gE5B!(oBFJD&Zm zQlr)+udpyKBSSV287IsxsqJXBGc#W*vBqkiHGxrQ@NmBNu~e;+ldwy6;q@sIRFP&f+)h??#8j`i}uqh~MruCYy#5w{>B0m)^1b`nQA)nFie!?|N z@KhOb+&7l%KR4hUuGBGC`3|v;G=Pj*M0-`e3Wye@p?RY?}C#&O;_$HUc5xNb)NdO!(+3s6GFzr#xR5(V3vNcHPx zktTjX&8n<8a9wOz)|qv#Xj(^p`3gVl@^C&bFE5W&0xct*&z0495L-N&*jgr2P{*FI zPZ8TV%sl1fFRp&gn>Iu-D`s~Rt~dq(stX`j-H;h+hx5wB5pfB`;Ff$7E{!Y z+r!B%V>^pKQd934Pl=Dqctqk|?7PxSwp+&<9?V0hCm%2QmJX#XCo0ujlySJ|Vulia ztk(LhaJl@hp`i}@ZmhN4*VXCIvE!!x=J*9Rl=8RIMSD>73Jt{2{ZDv#f3H$~{3ciX z1pH4%=Nj@0%;k8a*qB*ZCOUR9JR|syo4!p=O?@BKJe(=l>I)|E=?9w@E*Omn_GY-@ zXx85J6f>vpGaRw1@{x_qHNhog%Lm)>J>1tNoM*gh<6lVTyIb_0y9f0I(Y_q7=Fp{Z z_Erz8`4N~}Es)$WQ3>_IHo+}8C`jJFg|D!); zKlby)a@}ry>iS^&8ih>qD>m5g9lBl5b_kU|sIO+7AH^owE6tW$>Uq3w>~bZdiB~A; z4H~T3?AJwu(11%oxP<=G4MssD&xpSbxZtsr4^b4XggAtTTb*MG|MZ+RfcAz zZ@{~Me+^~QT$~*qXJ1Y-PWCVKBWpS!8jw~KiGK$)MuD^LH&I#zUD#`2J#5-ff1!w< zthBd}ZqfAFqSymxMo^M5-iAgRKwY;FCRAFopM|IE_JM@MB0k~!_jTuj7{zuE=a=Zj zW%CW?V<{X5$lc70HT0Iec2fsd$JO0Ia<4TR zS-(4|L_b`pKllU`4)U<+Oo^$eS(IYihKZ}uJXC&y&yjL*!7JC#*Jk=o$j8f6e>K54 z%1G-Pmc$(t@nLHJfh89;llSk0J9+hny+4WDK1UbKppxwe5{JdqS`^>$_)LY)+Xj!z zeJ#Si0oZL1(2YMp3tJ^szSw1PPB2=Q{d)=5C9hmE1}=_V`xTc(LvrcS0`s$^%5(`& z)H%_yrUYOoghAf`$xd~h**?n@mxB<@cT=XB-l{CGx(}p{CEeV(;SkW2b8>RxNqis9 zSY;;vSTAOTv@)k)nEvtO^2bYY@f2>|oN?uN$G-p`2+Ju_wjK`*u!scKx1Ipmn`kiu z^2H-v22sK354=>!pYouwomACqk-&vGN*UILI`a+Z4AzrA65l-E=O+_c*-^#LRbQT} zMNp8Y9IDFh9Z^!W%tUaJkuZ~!IqN>y_OW$_?Q(VYWfbvJ%WT6iahF3SXu%x@x>u1& zR^kR3NS7)V$}ZKJPrll7P;ros^lF25w@Byl&uf+kUj`*+A^X(0Y)qvYn{n+q7v zjgt-fzG?*6jdsvwy@{FirD({X!tjcN)yv(9cUBKKXCBJR@nDkqMMcy$ZD-=n$4ku} z3|b9KhKpBYU8cXu-UB%UpB7#C~;XYIJH|Z#sMyE=QRbn%JfC@naW$L z3wO7+zu`q|&crZT)XJ7lH2!JQ#$yHWYA{m%)4JeZU+lC97|a|ev;2d*2q5C%XaY9z zxb@tNfq{W+wMyOXG#St%KsmURtqfFGo7%5|#Y1+_;FUe(p+e+bs`TZKuyK z4S@rtN&7>=E>~R%@U;coTuRnL_+ckw{vKfSqii;cD<)(dq=R?98UVx$KPqt3+?z>Czty%Kub0^xPte9;`E^t-5%Cd|dX^1d^6{her0%7^P#@jaGMjt!vYu%aHol*EEV zdjY4Tc5CYcaa3=oOH|Hz!>I%AE)T%L2K8n8v{HYnw$XQAw_jF~96L;EY4+A}0`fC( zExbs$5<&cJ3#NjeO8qsUqXPOfhrdz;a8sBjXS?y&yjTs2d7|Lso+&evb$bTMfQiaJ~;2b61v2-}{}adClhQM;SBR6N_w z>bMe&@t;Se?FLj`9WB-x_9B}C(Rl-&H827JNkyS#J5_>_UEY9S3v|Jmb9L#swFZAg6jNyaGL9&79jGRz zqIb<3jj?X^XOv!az`USjKe4j?DrKfpPY7_Yq$LWuFB6PuYE8$EK`@lq1yjiu3i}xV zzkA-J3KYwgbId(V`JkI$MjP`F(N2@>d@x*KOQ+2mH(0MO?cL4h-%xk+ zYM_Xn=wOYLFo|W{oN`)>Z(Wc4o?$)PfL)AXR2RYKQ&ABrSFc`o z1`!l9`8#9(m73!&f4Hd+M=Oy3m8X@U=px(`q!x)F)F>38|Tu-h!nO*!kBtkMWPy}>1@oH=m|pXCWa zpj9rDIhui!=U7GYJ9Z`}8)SoSI$|AIf8oBJOkdrO%|RM51-GZ$9n?wodzeTd*`hq^ z{pIpIe(PQFrdf>u3C$}XNoOlIoEV>K5w}mk)rR?39LP1=t_qH4e?+LvMMS?mn2iQY zo}5x3@Yfml=eLd!^?hBZZ{YpGhH;Zc^KF&6`@iKYL54KrGjJTI)3x-avrxR?MkMMc zrGTB`_3v}HecD@p?8@_aqu7!Hq4B%}fj@U-W-}XP)0}XTeicBxIc?topj`8$=HQq< zTx_faIV2jp^ARpAJUj%u%2|!U>bD<4ZRT!)GYe59Ef#mAo$lyYW`DGYzE~IfVmmQF z$PB@u^XnItw6(to2n=L#JJs)Ij`-QXAeABSyz!*Ta8LJl;zq6MMpEFQQp1i2t{m zlezzZUL;=PpFh1Q#;sR}=iT**TyGdodlb23EHFK1P)?Ya<>V#Y0mcktY?Gbfyw(gd(LPI$P}tlR1Jmbn2`6v=k?cR-qNvQJR<9iMR_wthv zy1gv;9(jhLePmJ3^n5~jWtjs#0NypCCDN2M!#n0wvtEz?feMTYipUAu!5b&*OUo=N zMvwjtF#)atRRdD~zOJrZ*f5eZ(LMcRydjdx8!Y0uO#~13bg__sqChjh3QyM2wK(k= zN{EYl5Q)Vbf|!BbdSOab)1DeVxOP3HQtVj{1Qu~skiym;k?wYLVg+#mTrg^U3!lVfR> zVj`W$2n-IHi15y6`oPFYIhyhruN1*{t#zr2L8oZ;vug|K@2H|m5`d6 z3L5yhkLW2nT>Dn(vQWixnwO z^2x*_@IRQCP|ES2^=Mo}c|a(H-)$LYUFHG~S+zoY0K5ncCtoI&v(9Gu4Mnv7FWb&XPS5M( z-ktNU=E{u(dW~Om)kZLG0CRu(^od&0$M5ja%IE3U6iEAyocn-r#Oi>%4`2xYFb&u5*HdSG&x(pXb%@N_hPUveFXxrt{WE;89lW!=$&U z>ZfeU$5GMVeC!+d47tEf&ASXCpHfQ=|EwdW{|oZI0{XS3-g1`l&%N1Ze=NOrQ%r9- z9-GZl6MrL=$l!B59}eXs|imG8_IkoZ8I;?#6kY< z-PrBTuOg+wsA{j4G4`Frw)@w|dDG0Zi%GfM177dDi)^3AJMO4%5M3s5TEB@F zxWWf^bjfK_2CwdUqd+G0cl-5<=lZj4$1P>F;2m|;hJ2@wH!!;nhI(MH8}0qccRHAf zT=lt+1iLf6p)w={5lRSdr`rCb7j|%TB;c|k1Q6znu`$lxC5+p{S)cpkk9=C92|xd;ts zi#MH!re!6_R1#0VS+#g*NaEo(oUT+pvAA3NAIC1~C`n~dq zXaCQIW<6L8;`II&z0N%6RkEUm=1f(CM)cq3OQ(zYK2H~dgp1@A4g$2Z9f*2g2!pR5 zer_92s`G5X5iaIzI9Fy|H7%4s$J^4$iwuJMD)#HzgOp~Ss-=YxTq`Jz=GnI+AKwm` zmltcd?$&Bb^r>}o!u<$qdq>ve4h=>ylM0e!($cgyA4SE*UlS9LenS`h)M&H(ukCwg zA`YEumEB(vVvk)iTt@AF0H=qdi1-F5yZ0^*?@HgZC5^+0=u9PiNGAN}Cw@i|_&xGHih@Fdh`COduj=FrEgFUR`XAWzSOB+R2Gv0!h^5Nw(%o0ZuI{(apF zk2?hA$BPxiDC_E{#)1f*ZLyga3K59RknTCvTetiWWT-Hh#p(8S?%x!!bn%~g49{gM!BxIQ;j7gLKkR% zsu<)u?7U>+)%3h^I#ciD4=gjh)7vt4z-1Yy3R~lXDoB1IW zd;1+iEm%-!3$=+LU<(Ki&UAkEgMowK3wT_ZH=3H50Ac2V4oNtmeXjRCki8)4Th8G| zPmO%ZA5D)}i`Deu&yOd*J4+Q=K;%)C@Za^M>R>Kjc0jI(?;FwOH(_STvRM3hiA{^Qo@_ZYKhVtZ}vEBsk#})r8W7FT?2O#Xn4zoOs#q(ucjU5f4 zCIZBa%28i=72ebQZ^vl$b>05L1BcmNJ0>XQ;J~WW>S7GCrqUVw$+;5e z$L8`$kEW)k=R-`LX}do4){C5IB!bc)^TZtSaG$MKs>(374oAws5ShTBm7(GnK_Zlq zmPT07ako$2DM+VU)@2VQV3}wuYlp()S8q8+tgfxz_hf@jx*pN0oP~8f{hZ#_*wtmU zSnSu?kAP0p$5g5YpYb9A?!eDLcqROVTQvX^H!T!acKV_Q;d9YKQvT$sAxN;g+ir3b zE;T14^}G@7*<5X9%&%B{<8C$^G-)$7!rKq*chO81UG>26dvjF2RkWyXps5-4nZIm& z1>rq1x?;UkLuHG^MGu>`NEPC1HT@u*4_A61m*J2hMCW^3)uo{}YS$=JGEvqQJrMnu z?@WXEL5P&B$NWDD-$J}P)^s9drKC2RcQTANen*1tX{Z=%{rf>y0UdvkVY?dP|h zVUL0hrL*Jt+MTw=j4>KtE`z=&>j+Q7beQ26$1qWP-%O z&vIL(ES=)E*E#lv?(y&MCr_az`|SH(_aGTKN%QTh``@B0NFT5w>V%-+z5K}_3?cTp zF#vi*x8ij!Q_*_NyU-xusrv*H70@tHQBm>cy7Sq4!5aw)395C=t*)7zf*@vpiTb7| z>%+Gy`f%f+1Qw&;ub>>>)9sjVjnkfD$McgXwiwODQ=x3S`|$$ z;ga?h_6n!~&@HP&_7LC?hXC5;VSpU9OsmTgx7`{91U(z|v$}jcmg-3lXJ^L)hPpbF zqrmo%LB6t_39HYAI;IK1sln9yYs+RlY+eWBpij{{fD-|oC|~-dUW%;3rvC#w?YdffF~HhWp?zT> z*ZZn0^`+Q!jI%ygjS`lmZKYy6agAc*TGx!2nb&2xv7jKGGYVQ7>*{;f5*AIT&c@+N zrRi7re`8N^w==GtGX|PfeilZkL_4y4e z;&kQ&*&#AiR!u1|Snmnl{gaOZHb)f5S7f*hgY?eYrAIYD=xiCoa9to!0r^)Z{ezkE zBmqy(76C^>ZAh0pMRkLPKdLH{d#89RP=&xH4O1 z@KID$l$4PXEx|bbf*7C%R6x_-6T<^^r(U&o5!%$pVY@;|#Ou@r_UqYk>xtpj;e3_# zTab>O)p(ZH_}6GP|2iy3AMn+t{Kul55C2dgS%CW75xCN3Wo4CJqTA|GL14V-*(qN2 zp{+g7?7a^%BO=*wj60E7TWiQSTeuzl^GG$Ql=y+kNbi@IRoeYYTo?pG9Tv9loVvdI zSAd$PUvMMHyU#eU2Sy}Ie0kOL%gW#7{-sVN$S5y@(M}4JRAwW6pJ^dwS_6W_H&yRZ zb>Y!#UYIPC_HF2=0^RpamtV;v;@Jyz_z%5t6_1N*{IQ}tqf#ZS8KkC= z+}vNE^a0Z+wc`uvC=~%QE?Rxl1l9kzV1%^e+GDZQOA*zkzLJO~>f2%VTV_FP2N$ z6ReIc-+7J|LIdOP1PYSu52b=sI59Q6i>z&1Bahxq8q_1Te&QctTvBu2Vv)7xhOvuu!HDZV>3?jnX`nBz~+z+(1 z3n`-?L(MK`{DR61SY7N8w!c~pcwsqh`@9Kyoj*HrK!1@#dm)!+UK|Ozd6+iqRf%fv zX}r0X2P08Y@$AP)xr`e0Pb@Pd9s~%k^b#X?NA>UQW|$(J2&R-7|Ke-m@fL*+&-!*K+=<7yisjDz^xo@@ijrVg>sF*dW>4?~BaX{{6XH7;%tRPozAufA zf-CdAs_r8O4jZ(=FU%wdOK{S5js}HxuLxLQfQlz^kfg>WAP5C{wBb}PbPWxS-N{1q zyQ?ED-m-lWlFp_kd;r6~m1I0bf-H3U8Ia@O0jkU%EIEFEpxNsMsWu|OImxT5hXe$? zDAQ@hZLrR@S#B|#EEv(q7~vAi1Jz(j+!KxaBh3}U+QavbUMf{wD{gSWXNm&EIbLfj z2e@zpK&Gfy>BC4$N{(0P@I3%GDsZro(2L}2+t&Fwe0#LRaubC0h}3m-ipr+gCHB$k z=4oUQ;S|oV5<=filZrzdX2I96cTL8=9NgwV)k8r&EG4veb!wrod%xyJ|9D8&^K{DV zQkD@BWNn0@noo%wUGR>>o<!{nXi^LDMEY57a*!M0FCcf0gIOz@-aNXVEvthg9C;c73| z+J?4t!!iUs*O`28Q3RiEj36ED3 zvi8|Mb7Ka;4~pow8V>*2`r5wmTUR=!{e5Dbhvp@9DhSC!VDt)6HMVclj)&Z!b$H7s ztTq0PHqE1^XwW#kHdgK~nd))Aen1$a%;8sJi6G4aVCY~Q_XC1Hq$xUw3(N$e=S5EPppZ<+npbagygDMD$Ry3TDU7zK{%y7wniiut2$_9H|)?WL#dB_$ewW1)8T2ZYzuiV3^-F7th>AzvtC3I3_Df zu@`kg%aQK_V?_d6(B)*g^;&x<@OAnG&`A0|`|rj(MFCehUyiVLgd%po-0~nmnmmnn zNRi<|(3D6?K|@pg;7Xn+$wWaR22&;H5+!M-_xVGE{jUr(QM^rcldz+?8Jl^Y5D^#@ z#EJaRJa%h-$1N3ygv$P#J3H@~n8qMowpv4a;J_D6zwD3nZ?s9d65oj+G&PPGf&a~+ zcI4pFVqk#q^G7^J78XnqM98Q3^!(QgXkzw`Xx53~35-R05rY*n^qb`O$cWHs#}!eB z&D9u(L*D{QA#hR(aK3%4ddOCv6hKfHE~0lpJAwqrL#%$J2U25K0b`ny1DIkst;T<= z^euLPz8Gh>=JQ$IOC5~0OnqCcgvG=7ol*Tb`$%57`~~4xF>DOz-22%_oI#P{jwGNn zd>${=hS*0gYaEqTMM5Ga6xW-$U+7c~Kc;4tEZ{=uD@0+S5)Rd#)oBH^@Xyd)C$g~c z@M`yS6V$FZ^BT0(^%U?L8D9xyMGH|J&8{sbt4DC4B0z@Dr?DX`OBev=U@#$=GQCdX z2J2GD%;2bEXfI8eh3Wfqa;)^sMr!mvR;5>`Y@e~2p~JHQMLxZtjyM5G$dAKvhLoP3 z9>4#FN z_#}*X=C&UmweXT_9OX~>n!I_Gmuqo^8xHA3vq6YZL^#(VU_0=g;?$%0o;6*^#)gs8 zYA&m_qE*->0i&vF*Q|w#$te1e5PS2=R_9Ag!!;FDBal!K6>in#6%}*JHM-qPQ;mR^YtBvkaV3Gk*Chy5kP8s34oaQw`L{OpA z{CwrcuLXsV$DckG-hu#?NM}|JmYbYU3Xw(U@90Xs4Q;T&g!y+vQ{m|dX^8g6bm}g3 z;gG>t^OQ{KR8E=At*wD5kq_?$1c*>@>E-E%?vz~;z*truX1Wft_HX>6fv60y zbQb>|YoF%>QN8%bdbPH8Wn8kMeljpBf?Wcg^D1sPvuY>cyR>IwPXX}JOeye2C)EI| z}LkqnUU=KzEw)HM;KBO zF?RBjWM48PvP`0etXV2cLZp$MA$ug1?X`?aW35DtB}$=W8B{`xRj7FwOw-61(;ga^9p{(|Z$P02@2(kUA-+tXb+q6Ab+{nb?9EG^OHU0Rw z1DP9cEv>c>O4LAZu;nT>0IcO$ylV;d`tBFlauhti?sTWWGiV9Xe>}e zeFk!B7*LR@u(T%$KG=C(RKx(3K2<=eCaspBq>B|&&nE|7c~^92?~Pg6)%<5v1y1PJ zcnhibON&2Hr;fq=%rA<4yiFJNp%3V%-UKZ<0wBZ@3UjAcc<^k$SgB~i$mfV+1Vr9LCm?GX5}cW!MtVU>?{WI zgzsO7yDHGP>od8x>X}<#-@USrJ5mzT)vFus%q83r7vbpg6cuc44{kif3W=>u9Yf@` z^32!!956bnqD_wi9JoO~P>V(zLqS?)3^(L6_6GZ|X}gcyNTw=$m!5CoKi>T{ztf() z)c_pZng(#at;-pOTOYo5JS3I1?Ac_tZCC4q0{p!| zSEVEU@_nkNg%rDDx@#^-e15C9TKwblJM>3sZ*yaSO1j^nS1r}-9W)50G}nm9t2xl(8ar! zx}1BI(yWvh{8&_ulZ~zD1Bj%fj$i83W0+xsD6TW2d4s^s(2XNS_1}Y>*Vl8RSqtE| z;u`D@FMuIVf*rg&Umroc{E(^{*dH71NB-efsQKEXJ|uWm2y}{4uk;m9zY_ZSSX&s) z=&vl9o4-7T#EdM^**r+(uSvi`tZ^N;{g9yN$|)?ID5MplTIk+PKS?(dTx74wirSh? zmv)n3r7X`~N112kL@(`;C?{mQZA1nBa6zTi%ld&gz^A+l&FoJ}n*AR54Omw9my?j^s`tGY&ub$S9VKW!jLk=1>H8ll@{t;_X^h2-E#mADK zc(DVMZD`*)TIaMgX6YYZNL39KjcT1M%fVJ%t-bBgDZr4Ht}9^$xSrhup)Zh) zmCx4;oI-RfbhV8IO)OABY0bo$p76;RtDlPARg|3X*s^hF?wkM@*y)Z0&uR`wX!G6q z))Ex$Il%<39uX2#*FG5F5`MmZ9+1o75g{S)7`f<3Tq!Iy83tP8)wqwa&#wDq7461aiE!BarXd+1x)o0x3CdVza?F#L`FPg}EN!3hq?C)n$c;?rV zosw?-UH!KRRP5>|mUpQ=Oa~unm*-6(10u|4Y3NmomRqmDNU&TDz~znrv^xl#6XZKh zuA7KT%?* z;tDv>5P%E1&b(R%^8CAZmYT?4n!_3vRD0VeKL^NVW?C5Mm=ze@^Ej0l?la^)io!l) zDpS>FE-uuZ1~C#r2j36v(dm5X1x-J&(g97!>*9q0-s-dSJ>`mrfuUhBfNYbpU+Hq_ zI<-YH@@U>JPf1IwArTjN{BF~yjX8>rmMK(~uP)YHQ?ax#enqb4=ZvPukGvFbZburO%sbt_{HJ^ylU0ySfn+u}kCehQeV( zd()4vS&%XNtdkfhooa89D+@g{<6K|JShvevqS<%TM_oIvVIFOEH7WX# zXL~T&Es(051~+nxz6^&zUnU})VYq2}Hi5b+fWIZYwk*j2Y?)OrtJ;G{k2o6FhwbVB zL^oPpU7bzz7T&*4O3RLyi^kxdEFS+fU+>xTn6>0l=#b}t@ziLN(k<_!#9G8h{+9N< z#0Mj4?lCsHbsNm0d#tVU8p6me_JbZnryxf&^m;U?$N6Wp&fj2vZ`ak0Ngarj--C*> z5>RNQmhi3d$OIdxFSoalm4)_R6Sg&;;pdQJNA?GA`Y$N5b*XnGr&=rU1l5*zi@|a) zL!*x&ft2ir_#N;e6s_DWoZpTBn#B@O>Cp>xPc&id)@8PB1k{Z_J(zh@$cVbnv@Z-hjt;aRDpOr zJnEo}m{Tm@94JJMvG6|&y#O_-Hq9z(4&M!F1mRroBgso=+7*Xw)7J%Xn95sb7wRwe zuhmAou*cO`reJy&%J{6R7v(j~TLrr=zAX%1sx$IeI));pICO@>bbO%*8dLb>IY|2= ztC2noq-Pf3@9%!y9#=B1(gSB<)?>#IBmOft5u6195mYkJZ-Ge5mYMs+8J70XPBz0l z(CFLb$hV}7#o(Tbp0{9H73!mFR{0~!LFdt!kvBVX8W?7x!v5zGeib`2i}j@W&%V$T zhE~|J2<~Hxpd6&hJgKK<6eD9QxABw#DGT`kjXPaeWk`+h#P~t55C>>)(bK1|Vu=AM znVAm{0#8s;G7QjlOuJ&bP5L?)&b6`%nSEXb)&Gp!kKU@pY{H!~W0v1h({5T|pf&R5 zQ@l%Xa^;pZ)p|ENJ6WK(xW1yJrX+&qNp#ALBL+(HYg>Xh2dr@WC2*M)bij2v)$0j_ zZ5CXvP@*BwX+PPXyvI&BhOxp>h!r624+TmEXCP#2!#J2ToFe&W?ZW|DkT?rJL$_>& zA_?6^koam^Y^v*jv)i^4RdkiwuDi)=i27ZR&;(GO^G3a|AjOWMXijtLvoK`spRQd% zBLjEJ^2?-glEjHlz6i{_7z6z4+7Nu1KCyGP&OO5lg+keYSWM|Y3vVQVOxhIVR?p!S zKulI_S<(imn~peMB`PQj^zGUpXuxwZKtGHZL` z0jmgi>v8DoNi|g@9V|#$pNZW)6SDN5J?<8E0%3 zq}G)_1fv!c6@>v%#=6!g`#@7?W@`F;zTT16>6JHS6;hz}dp=5opvwt?wu=esP^@|@ zhRTr)I-)nOoLkbYkoBC>2@Aq$|&sRJxK@%Pe1S!UrY*;p}9_zXTzYep$H9(Gri6BY1ox%M{vE{I$n%U`PLI zAyxeiv7)ryUtRnJnaA4%QaOLL**&?})~KhN{$@feJ|Y55h1bV$@?MnE zpQ^odeHo-PCD!D1O_Uj1dTJ^aUe4Z}YhgF_N2;c1bnqzp+&|ElwvDG=Y|mo~@7O{Y ztNpTVOFgeGe@CK7mrW%o%m z9*(1n!hgD?ic??C=0tt{KE)}8)7?DF-(|2BcI%?Pn_KI~)7Nkjcyr&Z|A|oPU9Qj^ zqmhCLZQN|ts9Sq2-!L=Oj610TDs+&@epDvogyJRtwnWBjTbl?S*5H0nrh&&7RR;4m z%jd(J2Sg|N_tx)qn*y#@U*AHF6;~Fh3SnvLcw6IJ#)hvspAb9v5u)bWRr+_`vos^9 zhMQc44C8`VV~V;}8M8rSk>|Z3wU?vAEY0v0fltk}z7Cs~i=K4P)AD|nSfENuWiDbw zO^@Q>C|M+eF4k{VfMP^Hnhjywf{sZcn~k>hEdZ|y+L3wE#OkDqONT0Z{p}@i;gFAM ze7T){7exSyEBC;z*Bg)7uG`(wL?$b?5#Ank6g1^jwPaMNVz4wi$8>9OY_wgYq;2$` z&{TbFo`i_c@4Xg5Ei8jZ1d57 z(4LR~q_{0kM7>xatdPducjXcuJZ79JEpUe=RHN;v8865Tle!zc(`u#W@zOBDcc1C5o^H4>DWTFYRJIu=GC;{flYmZJzi z%VY?SwPUQ}YuHl}=k>q44z#^ku#W+3D+M5<%4kw^fWwUN@-Yc9b#~yn#Kf3xJeH09 z9fRndd@tyGD}-hDv1QE-nvtg$3*PPHuia>L0yBT;&>4QDRbu2RK2ngG0oWN`F({Dk zi^IRRs@f3NR^%hbBxldWDfo(hooS9Pk>8WHKxHr1_qsqUt}|jxmWS))#R-+^m^mi; zL_Dn9d%HiViB!Jsre0PpC||zwaEds6{31qhm2Fe1`)I%HfBQE}AQ*GD3YRs_8?O_Z zBaWoT-m1SExTctH9Qv;J^2jX4;SK_qR;h%f<2S}aU^aOZQL?dT9Z1!=y9Ss0GlCjk z>ZY+nifzTY9m;y7#yAPBrR7C!xHETX!<(c1zK7lLM7d{FTwpH_7;JsnLgufg9@pqY znOm^NYp`AgtlCgFP3BUhuQ)0lkvH*orIWof@@`Ie7+AMZo@JLAqJmPhXCBGMMj9;m zSa!E*O5WNp)PVhx$2C>nLekOvUFJuZ(EBevws&csWfWW+uB)P+nVyR!s!Yx%U;i#R z9>yMJ%^(62RIw3@5!k`E@gg3FNF3Xo<^D1aB(}X*7dcU=3HtZN>zNyCMHy}!Ls5N+0LQfg3 z6kbZH_Ka_4k0T$%S<(dlsUpgYV&Wh2D`Qc8815QKkRC+?r-a8}-+U}&S+oDVrRS6; zk_50$yhlwbj_~v1_OlwY9{v>+aPVwyK*X31X#DN09Lj8eIBa=7B#rNJS1*UD;P&n@ z<+-y~oW}e5SS~S}!}U($G*&uSJXX|1A<1T)99rfJ zJHgJy{yU%l7`Wza_@7<3Thp&94SGZP5lpYiosW3evUc$KDQ5V@c?>N|HJtW3ds|kW zb?3ocy`?#%cL0!|IczAEr;}J8MBRUVLIdxmJYS;&gd5E0jYhT;U6(}f|D7pZw|{Ns zgm3>~DY-h6Dsw(}5a)&_pQXU@$pE5HIvhA+t_|bsL-{k6)Uxewzaal5*JO>9P9U%Y zSd#O?p_Ma4{2S+obchMkY~d*>ZJI!sF2YQW0gkK#fCgZpE#{cMcH;(?;XrYFZ0hrY z>Mn5UDpaQj_zK+N6A{HTUv4x=W&6xrpEr-PD!$j1x#5>fXgs4YdhhR8cNUJI(EhAtV#a_UzZCOM~uy=sCQb22CX{q~aM@mjJ)l_T@P75<+VU@?(ALE@5N znIk-IMp;$GEq}oE!AAC0^>@@)I|e4at9V{f(nZ2HJXpemL73*vL{VtV+MpMeK3=g_ z7nx-NWGH|^s^Hn|-Y_LiTzPD19Lxte@LU-=0?Eh1$EKL%LrbnWd9s#Xg30;shJU}3 zeE(%e(yw=bG|(qyu=;hSD4FK_D5(;;LF!ZSn-byFSO01@C~|Sxr_hOJU^0`RA*nshfGG4euFtd<)7By z#ze9lZlSrdRvsZ0p2t6>nvon8)gheclTunlspkK(7Q*8lqJ1@_dpurSMC>$^iq>yQ zi=Lq5LW8Csb$hw{qT<0?fR#z*LO`>j^AD#T&q1vW@(y`*e7Mno2>4-8sIR}r`IE6& z%9Vbt_>b1T>6E>=7j;iB#AY%=MW8It*71&Z>7q7A#^T!wY8Vc&`Sqt#Vz`{_2lbyD zUs!jlGRTZ~URcmGGoS;qqD;U?x+f8}+((BH9Zd<>_8(A%&io9eUknYGwcXf0N*G!` z7T4Ao=w-VpG<;c*5eCbW&h+ML$1Ds?C|}W6E70y(QX9P`Xkft$z;tl5a{irQKt4cduSv-6%;(*&A+C;th z%=@`A(EjHsqD|aKasC6?2mE6ft!g?qns6_wsa#2sw*(FU?|cSNQS3}huiZZTGmw5bVndE? z!8YFaT2uYn?}S}L=heJ@I23q=_DhFmLJ#vqC;NVk+QO;Qh8b-L*Gsd1pb)u`kQx2G z&PH0$CCV_5GD+@I+O~Nrxn*k6BX8e%Zogmu7(YNKkjP~10^4!jF@ySnn?TRmF{FL`WLc*y;;kil&U(D@0^QC{-CyYA0VmLQt> zmN3KpjW92)SMw$QxyKR0P@MqqXzv&Lj_X_GvrVV}v0tg$&?Bws!GceVef-Xfl>jHR z>A##hD}wvhkwATto-KLvc+O_g1*0cQR;s-Vz&UOGZ-@)#oFvT<2_xWM(o>q-ITNb% z0HLq*pYsV&9=p(MLXpxi{5Qb+C?JRfAq5dmj=%o-Lz!1sgQhpRuaGM6cJ4zntDm?ndt}HZeOBTQN2tyTUg_WkC4k>9`zt@jM(dVYhE>%yWHBD|fdbV)TlO zAXqfL>4icW*(CmX{jQ3Y(5ot#eW1NKZK0hS_79OrmP) zS01{7k50@}CuC(mgm){b6IANwq)=Fq2)T1u+Er~nFGk9a3B#{S@bu}wv30V78bVC+ zR>aO2X-+@ir2Tj0>SnYzm&@C_hK07#Y724=J*0RL%N#D?^^3F!tkZnkGqZjxc@V%n z&VFhCrZiqM=iID-QOxl`LHQ#BAt*o$gYga=e?ZV*qO6%e0NhJ!r@l%)FBpG=;}_(VtA33cUN%u(H7UYm^O@QO9#d@HMYvLwO{<>0Vtb>aauhE1_oIJP}Z#cZ`_gR zRK?Re759Bz<>i8{BwtOFnQ~k4$KF84kNh`W`a3t&CF#^C_MP>}RT2-eKd$^)9OE5pdSF4=A{0eRFPPn z0V%#OdY5{c_Ips6rVjRzw=S(e*5p8I@>=?T2@H+AfU!juu^?E zRo?|E(D~{7cqmRdG?}8)O!WWq>2wVUqhf~6G^OVi)j&n?ybqW$m$r&qugstCi( literal 137969 zcma%ibyQSs`}NRW(%sT64FeK_(o)hOCEeYUDll|Oh;)~9cZYO$=g?{CVAG8m{Ns2~ssl#u|H zj*#sEe;|IAlaT^Fzx?~voEHncgJLhMQt*ey<>nw24ZFE6o1` zN39qHq5{2_daLF>f4F4st~RwCa_W^MA&VR|=7rD1tf2h15JRPc3=KI9)fJ+KZ}Alm z<}DM=+d}6(y@K&*<{(UzG;HKOpVtSEoG9@6%20Sbci$O&Su@w%hwFhu53_g-n*X2I zGl|VYjXI9h%ZpC#Jg7d>z)|(~pFcM_W`~}U5D@fSXd$h2IQ&*6s?~Tnz$@B{tH-e9 z$T+-WdS1OJDSl>tdc)I}RkWKZUgMuDOQT6!`r;@x913JMdthaIj&fG~JthDB&=0nI z$?due`7VOw^t6{UPfsx1 zb88^}&6hE81VS7HY~a%yhdYANEXK1@KoKOo9omCU9_Nd9R|n>ci%Y}hYn@J;80g+2 zeC(y3mX?;46ML+i^6xzcg~*6P;ZhYj5fAL65>h@CHhKwgvT`vo$(Wd!3{`Fo`XSV` zJ`Au>y#MxXBvUf<<8P^Nf5PuG1f5=UG+)HH28A*DhlPbL_Ah(vkOOOzj(x3AKF#fQ zWqs|o?34IS>=7?1E@@VXmp(_n{}uf*$!x0_gJN0-`Am`prQz^eXAKpRK^ysub|O<7 zN_iet2H}N%vo$eGB3tLeV3A!lv$}nDb`U+?>qsHb!%sxePQT}S14sg!POf^91{=m| z1pl((!_DbD7tL=Fut|;#d*eB1KKECqlldw^WP%bUp%mO3JrIsvdx3_jLai#-XRr_R zk+8i#nSXC2`IR6iuRpUm6IJMeS!wl~t?t22^uwxhdivlMx5M%U*F#2obWdyD#)MGI zX|kB8sPePf3gfB(uA_xoH&PLIdlK=Tku+jXLx0z}|DMAL_->ar1cUV5N{i3j9|zhh zvr*UQi}TTQ@KYBqoG&`6WrfkkyE70Z@Caesfog~MYe@4u*ox$jvM^`}{&&e=`(fa! zVq*@QhJRK?%r(`Y4iWQ^@Y^odt=yjP2*ctcVUTPtR~XAMv@O`R4nxGA^2r%!_=7dt zUjae){_gq&tF7Fq(>^zM{MTDJ9-E%d9lzmI)=dW=Mg*Owvod=q@WLzygKsdjs3WaNrlPBAoC7eY6C zfK0+api3W)2Y2^X5FI`zS9_<%h9VFV^Pvv-67$iJP=2J@W-CIUyNgU<^X8NP-OV$* z%R!D-&{(aV0SFPe@mkxZhMM+9w~Skl{mF!DGQrRMu(54w3RnnyKO}n%f}_LlhcN%Z zR>2TOr&^ENEF{>?PZr>2xS#d=oNte|5*k8R+x@M&S#kc&7r$sen|Wv#u99I%x3(Ox zlX6EZt$qtZT*mLZtrx!}g3#I*{iJs}Yi}Gmq~N*Bvv?Z&<~H^U}w1gvuouZP#F*f9ApW`fX_ ze8&61-_qALzURYQHuE*jGungqC#|E22EGMp?EkGc=xre4-vU(zP)|6qDjhfT{>){O z212}mM@K2##Mp9!AcYo=lq?pFuecKD#>bC`!IGiOr7PuYkkgG`EX3WvSxBN@SCb?E zl_8zIpLQ*o#=VgsbV{z@H>FFBnwa}5tr`=XCXKN2Z=du!OKj=FW-s_rI0Cgme7pj) zRdThqCm2MWhMeM~>7sj6MTsN<|K$^EAQD!tWGE&moCx@=wa(B)pXZ}m(-pXTTq4NA z8*g1=2@nM$521BHEJGCrG2h{5}9-Rof*B4EDf{?FXl<A+l`rM|C(Rit6jBr%m15Z9B2;qT5q$qzKIP4lwhqDS21HDQ z7ALxOGxHU&?uTlHpL}``anF0N70$?oU5lL_+5=f(V>d9dC^bW{;Y3h!Wh7vaYV0`l za!c?W$G5_S*9?rmC}pf(f%8bewx?EOEB(N^*gY>>0DV==I#P3 z<|)?>{6(m_a+b^t5K4}FlZ_r5Pzt|Y>Hl3MqpXY#n#fhUJ{wLxpX*$xU75hK1|OGZ zYHAL6*Ia}cW<)}+Q3QSN#ELY^d@)xK%33ux{woBeQ#Cd^AdO;OExOm--1$k>SDlT{ zyHisV$l@xTc3&?Q71_CN8c&vyZZ0O2rrf3e&Bb@}X+rq^b5-W|Tm7+lz56+GdnvwY z>K^Pxk}jN(4AH^D2+|XBVOw1uf8fy;ivQQ4n)SVoctHegS}|VNBWY|b{yx&pl!^WM zlD@x)XPcCrkG~?YiSHo%Z)r8=qZAyJ1}h=0Z2CiuDek`N#Fva%xn`e;erS}UFE)8N z2?G0sj4%7&lOI@Z4}{r$oYM3~x;lPj*v?;~1ac$i7<`(2t71=&+#dptGmEj8AH z5AmW0cctF~m6mz^)vL<-x6MuBwr?KxJxwPIkd?b;YU}*cMIzMj|7(IFKy`w(XJ;PZ zVPh)rRyT!^#&DstV9l<-e{VM09*6*PJ(|y14@3S%{R#NuL?+ErGLQ-vS2`gk#pZ2s z`m@m@RVW7$LsyT1Z`x1co7(_dl=WD4z2jpP->-%>~}sGrssN3_kysi!F-&aSBW1oRfiULbrQ(Za`A<`&O!!iMX#dK|BaZAtD}YHSL^GR^>7H4cRkHbnIB#H zoZ=5USZ_gihNYDDQlKMi^wCa&W)su`0$!b%*!I1C@Z%LGRcA z^ll`S#PpZO+fQzY1Db)p868*M&_gHtf#{Ya5D_1SzAp~=0ReFY)~bCE<91NI&4f`M zX+*g4!omy*HlQvDUZX@i=N&x_p#^dR&`t1btmit~B}46z&YrVmEcl_P0dLUU{X-e* zh{G^LG0QrN?8NQq-0vih%&E-r&47noj1r|`GU}stux%=3{Ea~*f>Zfh&a#;+ z>TL(gi|y-^p&$omj;Aa8)tY#e0fP($+wYvBMcBVupp17>{@)4)FCr@H z;O6Gm>{h#Hmu-izu}0G9tcCn7m^#f!mOp<2L{Wlqx!-AA)*%V$_!(hzD=6#Sc54hh z9>gX?OWzZvnr=vVy1WPqB9f)?0oAw!NBv~P&=qB)p-KLN`O?qvA08k3qiK-{WLpH^ zZ!m`%V)f~eJaBKpW~7egqfC}-Wzk5X$I-HiUgCPfLw^sgnHH4!Ms z`g&d0a&;IyLHJ8v5V_BF@7OK?55&*!xII(=?DIbWaOPvZqv?k@#sJ)~zJ1bKi>Q70 z3|QsygYhkd@9jmy{_-r-+id8x+wI{f$|Jo~u|^;_%CHC!Yj!s1eYvaPCL^*97PU067B1USJCitznNdGArChZu_~C_>s(78pQCEfj~XhHixTC zqZ@Cy76PQ&zh3NZZ138s`RbrARGsuwBXUbd%oA1kLGght|A~z_jXfrGI64sEIE5d{F^1i zr1Cq6Bq{9QsGL%3e17^9V>*~?BR5K}Eq`@qGPx&`#N+EbS**=Vp?rfK{bTZ-Iu*Kal%T^$dWG{^hw8X~J%~3JW#ge)v7QnDl?gNBPLn2V7#zkreOi8^`{M zvu=>kpxEzxm|vX?xF*^!V|8`4bAevS4=bD1CdUmIVOh- zb$xwA5ZF7R{QHoT$Oj517uG;{38`E2R58D&lo|CxH599o-e5FB*y%EZjDr~izu{_t za_bgpmW|+(kfbbV|11H@z|6zrMlYnOjmA;cWp|AFs-Gd9D797!Wr0nVqi=~qf;G`o ztmbQSjHvL|4}zsR04II3Dh*RtEQEAIXypGSyBGuQeJ* zH~aQ7qK11Ju8PW99D#nsKSJbmD%uA0-h6}BmhT)iTCd-{!7~o8l0M(IvYadxweJ6h zOF8NyWTP6<)vzlvo6#;s$m-s5eo!{b-6M6pSRac-;V$0&0)^}ABPqocD?WFF*h3&0 z0HaCfwACGvxIN!K8Lw9@0jT!0fXkhHaH0 zLfO641Ojezn}pXA@1*H`q#Nq6y81T5ZQ;);i*~-@-kz9(JKbxcyPPT&E-b~=T0D{F zb`JjR?aIabBPYdN3RS+UWrjRbhb*=B!M z$O|!xxlG_NP|SK4;l7jR2HIUH%P4cnUgo*@`4+=?7ea!xhx+41by zOkG|^ZPZF5dsvG-nX2$ImiipZJ@nP|C*idnE~HwgGYIe1=2bj>ZOPJEyPa?#lV%lp_p0qDMhIUIr}FG9?y1s(pH?4*I%T|1>`Hj?Su~pJ{^W-BMa(vP@%Iqr zh5lUF-!bs6=yebiTSkb5y|Vp;&*F4*gE5q7YkPyobS5*SB=$H!gj)}Y-@LDIZskb6 z((`X#&KTs`t+arKQU$ASls0<)XjPjX$>>~Dj_k3j5I1;Rd0a3BwnxEsneK0K@~>63 zhcC#(y&69$(twjZLM-5TQd=qq)9f-Z!-ztxtD>xV|@Qb7jRY_c6j=VA<^*eDqv?`v&{9 zjWq2)M1MDv&G`Vb77xf6MbTk>29D2FEJf-?X8sg=V!1#CD5?G6>ZbkY3yx~8ywOal zp7mnoaN6W1$qz#I2gmL^g%b+dtE-w4FKsZHHKY18z6jY~D6P6Q-vMwa1yfL0WTfm+&k{MI{%p(M)r zKNg*}E51cN)Q*Hj8YS~t;*S@JKX}{rf!ok?(ZOhsX`O6vu}b&7vjDw*x`;iQX>O>U zf9frbx4I_t-Lo!9WR=uxcVa^)kgZ7!4e*ob@yXMcg((!V-ffM_uDzR6=p7-<;C8y& zWh0$_EH~+oK?2R!+LgiOg)K%=ONM~3iE(4kj()w>D+J$tQ4>~D;=wPD6+WN~PVVgG zD)(u7&@HDLPWN`~<`_&+fFTm~{6i8PrppgBKULh<@`j6b4uEn9E}o4+Kx&$rCTXiU*im}#{86{kK!F~OQuSZwF^CF)lFl-Tf7$#Z_gA%Bt9oh$f4+hiYWg>}APxsLNveB?i zI$_i@>$W|x1olpSl}!nT|K;oHX^-yuEGEF#iKpPM~0bi9>3o~K0l zkC5&SB*yL8mN5`a*=6Omo&b#Ja6XuGy6XMOw-u@M;kV!{S?%7dX5vgHPJ_T? z^>V7w=@Mb5{mBA5664SO*0bW@UeQkyz3|#6H()}P4aCeRD`GL*L%I8_BdmER=0!-} zg7)&h4fLw+&ECCh)Tw|ftGkE952XlNKZiz}$-JB-e!Jh@2^G^v8w0xprdnVhF;6ap=jZ z*KW(C#&|l#kp4-;^>CIyf~(?Srfg>|lv0Bh`vu#qV2}xL(t0PIZuB%an4HF_@FWyp zYz%X-mHB*;?dEOmSPW5Rjc`!-$d8!rJB9se%$D>az-xb$r`2A73{Yi_IzvwX%1{Zq-h+r%v%p68vPL)h?ciTQ^CWpwo`;-$wIM_GxVh1bi2^ zlkTO6At6;d2!|yCYRiIv2ZR9`$mUby)l}_@r_~j=-}7uwdb$}qcA9T#l;6T)RCsU9 zUd0?-o2H?*`QW>G(QC5ZiF&7ue$`xWLytEP52XDr1~qRE3}u_( zI(y@(>2UJZSH^x9DO_M!+Z!rD%YkXu5*&0|$F3j%SewW7lAECGArUATm2mkFz;84W zua1|5Wx78gEtn1xTs9>pCV#iGSg2#^Xd5OjG_(ehvI13t4MqL;ZVFCI=kHPAwk>Smpw zK!RW_)|(EB+BH9UuAFy&CwHgSsmad;gSUlOv8Y5;%fjm4x!(u}1hUxj5FDzM%lTvW z48J)&t&nuw5>jn>7lE%QcDE~bzCGfTJCX%iX{NLMpBKP(7uYM%)?nhy2wpVn)|0uW zMv=xaNOas!9>6L(cJYTJRfg@bAQ4d!67tzrzr);eDGs4W5CU5Af@^hAE2+dHMqHuw zx&+p`gR^FLiB7H5$$Ycdd5z7&q_WheomQm@3dpYYk#C{a&b;^Pi1asyF45C~97m3{ zrw9H|0>T}>&f#H}t~Gl(SusvwUEJvihEgR|y9;#zr&U>)-)$iQw{S_AW>I;0#3{nH zqNyx11@{#0hQlnQBIk3HOsaP?C7LH+fJ^|G5dUBz$IJ+B^Z_8yRm%k2?Qw`%`A^Mw zK4()zHR=NO6DA4lD;62 z!F12*2z;9@@(UO5d*AbBFQp&+>g`U3Tl2BvPd@wm?cuFnO!7O^ddn$aEwy}XySl~& zPcXQj(%n7D&cD7*ag}p6R=kcy9vfms-5OpdMMV$>8d)Woug3a>BoAr`^q3m_fd~dy zh(0_jr8V!Q!<|&yHXCj|+?GAmIBr!LU=fus62+2HP>gK$$5vNKZRU=9h#xxw`ZS{9 zz7lQ*>W^?=+LC$P1oM?QT}wF#TsxgE1BR&r@I?6 z&xX(45oOJ11KVc9KkYbsQlHJnsJJt(84X&z=ik1RJ$@yiOcV3ll93BLGq(B;?_URI zr6omXkXqF_F{Bw_Sy4}k2WraSl)B&v)E7u!+v>T&bmD`h=!*VWOuT-i?=?GFZuW{@ z@x6}#NP%Ndu~wCkwiOB{rmqzM5N!WCI8@Ube`dB5a_+ zDbuMfZA<1cACHNR1$5Ki(b3U3Cezzg{zzhX*110A#fS!u0ySlpYRvO(nsx7DH;dObvL7Eu&&x5Wn zvXJB8P?|8IKbF|duO`3aMM`NiH2>a|#u3+2sKYm|D0H<_8|$rxR6$bxqg$W>f_?$S zvJe8G?aojvgG(=ej@AcmyJ#9|@V6g7e)vA!?o=O_0J>CPT7ktxE=X6v?W#S@#2lk= zvI-By`O>#v~`29U%WY(gF!2`QgL&#%jKkcr-2f4DgaL9o=T; zc#d4}pD%wu=M=uk#E!k%E#4klZpPZ=0;F&eDWtE|V~YlM5$ek#zYS>;xbdG4jh(bu z6?XvC>r;cX#WJu03|8Gb=p!(!!hKCR703$A7x09eydwjWYZOjLRLnLSs;Am{eRZTZJ>}Cy=Iq9^ z-+BA8+p%RaI3VefPEC@t^#5BNKqd1*GqDsgAGsayKL8wvTr)^>DEI zm=J}KLJahR{OgTTq7784oa4^uR=j`!k90C_ld$P3yy%1Nt*zk1#2M4X;E<44BqWv_ z>+7f&M+(Bfic^gSWi5ns=) zbZayR=Jp};;!!FmJ6^xi{w<0>kl6WrG-rvxGdjJvXqs1l&BivI4)#gGAmv-+HywzB zh>D8V-rwH(looyi%ma&8e0Ix+o*Zd0YMe4H9azfyzCRd9d|gC~5g3#o^nb2qtT4P@ z*R>c+4wBxyGZ{=6cK7mv(>+4Cu4LbxoSYonpDG$vn|guwwq8JHb!p3`&{nUu#2P8z zfwTH|X8MUVIb_>owo@nI+>DParkQ;JWc*%U-kA<~=@IjBSM(5};xS@h19NM?^Q#3r zju&$TD#J_k-3vRcOZB71Ge0tL(PMnjaP}$8P`A!4v(kIgoYAxSDYkIsY0FY1z*exbcck9@aQe2T>Q<@~_C6!#de4od&^M)n9KtJ^ z0U)Km^yPN!4S)CEoCEHa7OtoTT<=BQS|@7WiN~ltU;pfjK{!#ptUUJY+?Ao{@wr$; z`0bDfX_N&%vEDxgs@{{ofne_H?S;$MXYqFT^!%7BpX|b8HuS|R+z6;o%qjmQ^V;gu z|x8yN*z{rn^UmcEU2e<$Rw{#O!%R9?rt>VCEE=V{B^vZJe%+&^kjY84*tj_7Ep^0Sve7g$ zcR+paCc@>lT@=u+wJrJmt&dzzviz94+H#svEz|NcWV0^~EW-4ohauv09LgcrneC{|BTVQ8hOLsk9_KvLcLx*V zorZ+Mt%iCT$rI;CMf{K~A%X8$9Um(ZKxf2YgUt*}EYjTcOW?xl;z)FHH)nW#CZSl( zh*MAT^z>vhn*R9gQ*0ET2`u;&Z~~4;^-_3Q+W>tQ=(|9?9>zU}f@uYFMM_x$uA_H>h_SL0n@pj_~g0AWw*yEt2maL_v z#Rvul=J~|IX09?Akf3!R1kFcMO-OuAVK%n5q=QlMrz0rET84vAaFgCx#JJ}FlM)Qf zXRs)9PLh~nPyHZAJ_HF?k!UQiy#M7X_E8YeH|X5*#n>uhPE|YHoRJe*otJoy?w-@a zL~Ktoo%=Y}2Q#?O>|5bS7541GtR!A8(xCor$&Vyb((el2ep~!Z%4fX_$N()jPVa8Y zr|*0LR#lJWcVD7YGG8rcce{Z#@kgu53)XSVvfSm~)%?q+q)^SPL#*x5CtXraAdb*L_`KLy6cjQntQDujq2who4(&|} z?;CsXCvMYRq?>yN%>p$hmxWvfYB(fJKgq(g(<9 z3qaR0ZBN8d2{n4_Z$pr)aJ`%R5c z6`v7+z5!oH1TL;_$pF;2w#cPMIK>RHjM_b`GEpLjwGKG*tluKE5K6xhewwdGs(I@O zoA4AM$8=FSs##P+#|=-LQ-$Xho=5slZ2+N?yvIa3MM3F;a}bB0tujQFkQU1)A}8pn zH1MNuOq?MFcYk+y{U&bAY3H?{m@S!cuHuqfg?4q?bpkv2RJne0m>Vz%T(l}{P9P#C zPEJS%GwL_FOZ*^UYbj94>X`?y9EfRLK0Rb>Vu z?3DTR=~G2W1WEFP^pEB9LzXf%F^4mg%gv;uef^3G=~}xv3HDW-UtKA@HC#zC;_rV+ zc_P=ZXGOK%<9t7;0LcVoF)@*Wy=RX_y=T=zw=LkmdE2K!syK`n4Ah-Z5DwgAzgF=(%@UU56RPsTy+1#($T$}=*NOApdlni^pFYIT z627V&b$3@Tw_k%ozz_C)(6!E`2rfl`{uS@o3gg~Fn18m*!*P2+`uk;2S6#7BXZmv0 zx^3Gi&!cSG_Fb!qtNWyw4?^+9DpbvPH-Qq7JeaaWH}s^>J&6F*1$I>h3;7}>O6rCd zXMgi+%2T;ua~>R;=|iT01ymsfGt|&-fQ|7NOiV1))oF@*-#d;ZzVG=9KoCW)W{v%e zcHmZ9GrT{pLo1B0C#@E5-X7ThQ4n>??OQ)-$wE~Y6InwLM~?)oMT_884l`fKBb_@mXg`=*o)xz#A8$Yvd1!>s1tUER!?8Q-2L$m z0@_*0V)@!5nT5q@>U={yO&gD42E6LM5Nt0Sh0)#fF~`Ig)erS8@^Xgs-pIU(#lMTLvrAQZ8SC?emo(qIj$c(!TPoH% zEKG)gT46ls*H{P6E7nxm3|TM_`gij{J`clmu~b>t%gCF?&dpfP2fXZDv0x&kAiB4c z!$d|2Dn+x52Pa!*-w9bvr|nchIQ1$oG9G}i*#YM%0>G@{x))lm^_R^Jd~XZTaByrK zyLt%d>4Lr+HU@aW+K*m;`n_ zr8=Jl2=IZAHY2Hmy%Ag}p#Ow!OMw>-Qk%EIpcI^eD%upRYid~+xvu5B>l)~U!pS(v zYt-~s5z1S>EfS6rxS^PzhI_?OxBNb+yHhjN$PRsSa4!WbW-}SHB|Re4 z7HRF;drW|E^V(n3pDQ{7T#}*978Iwvh0dYFs2UdylS zz%0X`zb?l)+#FM`5_jd4jx7dBW`f7 z`1M>JC$895!kMK9CHIyg!`UW(4GD-6K>kK=r37|Atss^~_&tj2u|K<(pLB)<+|tuL zpeHbXDql5~+ijUHo@EZtqE(gq1%K7FoFlOR>X~q)@kjzmv#D6`)@OU? z3Ogy(Kh}_;r#l%z*i~%~pG>#A*85iTXVc9(B*XQ%so{CXAk+jt`hR0(dYW1`{`l47 z@hllEnW=r=^>6hcnQQ&0cVb16e<TTl1o55d%e`?rkRENGSYEle(|)bTY=-^R`|VWWS%&)qg-(Rp6t3I?(quMtZd3h zzAw=&@uU+61}kc$(at)xwg`qmZ2$oxeX-g(FrUm2^19k_I+zx{AExjkvd-Ob*&MKMS;FMTR{s@Z;ih%faOWl^<+7MtB07Jv^GnASr_F{*T(*r z(I-F83nj7Yy8xS9B9uBW^97S|!A8fe4^!`sEscyy$-tkxkU@aFqv7 zCM#QkW7rC_5$Y*gNfVSL?^2w!Ogi4Z*JZn;?Q@p>KC1x`WFSnj42fi%h9FRMbTo77 zOE8L+0ro?Xh;sA0d|LK92F2r0pGMu-zf)*u&sqm}EP{k6UVKraT%K-^z3Iq^U&ej~ z?9;kc!y=$&KPP|6n0MKq)Nb@R54ZV2AbS5|*Z zh#CwJ{$Wu?g>{l()mmnG`Fj9hcy(zX0B5+A#(+TwzQPO8$f&kk0f%#8UR#3?Snx&~ zli6B3=43UklsWq7r@#ITkV4Z*{8>3SPIgJ*M>9*bkt*U*3EX)JVEyCqxpM{_l-u_o zs?5k4l+xxK#lL*1P%&K5EbC>%c)4@Ic66A9DedvAqoOL$iCj}k-vlP2`7;~Sp;6&&JLzCLD`m$@g{3;K z`yn7n_}w2)YkDIo*q%m&PdHrci?xnmMbp#`@l9JEAo9QuP)RdDLKr*rIM0DZ1nsqKR$;8rGT;luJTNvx5^BrPByvZ+6=$cr%A{I4Z=hLis$!y!^ z>t!!2e2kX&keaB$qatB0S6}>1J&}4$qkgUb0n4N zsfW~#G3bRXJn-~DC?Q<0k52P4v^1(5Zv|Vt07*Aix0!029fMlGt>tL?aprW9aJQ;< z88@Pr$aqBlC!YewyJO}R?{kHBH}3A!i}kAJ;p93^=Q&U#Jg_YUJ4Q@2X!1vxp{}xW zmR$%YxzF}w!7IC_Q$%thXXStIwS<4!JrFS9{4F&7F|q7h-=N<2^Bj+-g^LUv)xtcj z*QE`8gH3Fce4EBZ;_;^bSXCj{_4c7^7*y7BS4a}R$a{BnBo~TF{)yAicW=&VM=_bp z)%sLXd{jP-0+q7X0J(q^r~T${7A5J;QSFMh)i4lAS@fR&j6a%ROe>s#d@D*X7ynco z=S35Kw`dO@U-wA7`1%R$7%_%CL2%_~YNG}q(&X&HA^G5%gufSc*^eXnzQ_xdUxh?= zJ!BM={?m!g{y>HZ;MQpqJ;8k!JsP%U*xY2+X}}f>S2fB;7zCN(uRbHYpQ zESUl(8sS{d`{OR^Su&K#DaI?>gI&uZ*=jREhr)tECam>V0r3+NS~r1gguAuB9VQ4v ziHtjBAQTEfN=?abmZ|_wb3i~y6LNcU2HqO2xfQ!Q7H;V|f8Mw`5SsJCrhRw#>nhh$ z_51HHQ(qzqr^e@Xj`Xrz@!7Q1Y)Z5%eqeLante9?ap+UJLdifK=j-yI{T@8pyCI@D z(nmbwv$V5#;>2b+&a)<|Emmm;1kk?R*kw$t9_I7aLKhD0JMa8zJ{FDQB)m9m3D~e3 zw+LdM5a3jlYKdk1eSuj*hQ>8(%kb@_>uil$Y|64w6uG4AyBkiBIo6jV8#G3{vImx_ z0{#}i)|QsXyUQ%#tlh`AQjvc%C6PeDsW1^Jzuk!g#>RRQ?Ha94FgBJlPsBSt&Nq`D zzyYoitp=0#lAJF6_!7t{RO<%3*0Y>1?x(^sO{q85e;pqVOuvhkFV~2l9=N5b8DF7M z6R%0a>?nPyI(c3A8HGC9M#!)H@Bn{s)ZYS;irVozP#P*d&dofpk00;mBS;w<5D+Wj z%j2QZM-sB?%CWJr-_9;wo<3h4Qm+86K4;);C#z14Jn9EzY8a`9#u~d7%(fecjnY5X z3oT0OZi$UG2MkPCrBm6&RZ4EfLu(ryC^jvQ*=NX&SNUemA-I6|`j0YGy!XknXaP1& zZxXjDs$>Yd(L}C-%V?@_E%@rp^gKu0DA|@@Cj=Xz3B{8&DK9vfccsp__bh64_4CU) z=l&S_kIMht{>s+D!HtaO2hfDqK1K^NgIi049RSu@hIJk*+Y1U|Eg0Q`mY2UU2WA7QO znHDaij-U}k5<{sGlt%U&CO9lIoyqIN<4s8<*_4wxeH(JKOwH2W`lN&lj832Okyf;o7_Jgv@9mXQnQuuMK05=oZYXOFvH9cb?V{r z9~)B!(v6l>casq~xea3oNbXs{*-af2^!x$tT@jfOY`I^wK+*a=S!3YqVGJl=X)uUb z6s*B?K~W%@CsKe5m;$7J)6oG%3p%9<=Y>He@XMRxe&g0xukf}q6xCI2~@G5FzoyOqezTZX+( zX?`Wc4;Vt!VQ|MeNC5k;u-13hoq1r`?6f^(1dKNTq48$>xcS~K1W~j+LcpbM-rdaL zc+-m?!!WbLNkw2@R7+3SYQq2W`D8USj_KhOsKUYi^p9CDs%eV_0lQ}8qI-#R0r`o` z^OwyI1hgxEi`+!Or|L?h zl~TRyy`;UWJG{Z4UPdq(Y5Zp;#HF8v(0%o>Y9DytVek#$x!^x9UNk3D_M)p=g%V?* zi95Lydh<{;(q|OLFw8I{x^O)Rbi$D1PX!`1?thVm!hwf4uDFxx71xYDEq$Q-gySp1vLb?G6B|ONQ$_N=Fh7wiA7&Xblx=lnqmL-ryC|Ux4+FkzGywf*!9O+M@qkWxa zcN{ad&%2EPq)h^7ZTSHsrLxQnb^bQrN0-g?_arsO@=*G;6pwL-pER|Nf zm?j7kg`uRoEUcyFFFRL#Iiis!FV!i9_Fq(c)B?H=IAWlL07e%Ez{#T-(#)h?S26kB zT9a>~!7JnA-uaT$zXq}S04@HOaz3{>xGAq6TG#l4?kyuDXR%}?3zeytg-J~Y?xeVh zsL>g?B)`9*s_@sKO${25+fjJmmN}HL`>GW=RHpr`w5oIkJ{BnPikCSu$!&m$*^NT! zMYSTj?)K_qxZdX9WUGZb=f#aMqJ39LLfK}BM4|#ppZ`HZj6oF*d)Z9G^{EgNP}U0m z0_|E!5SAZGDfv@(fliz&i}C_4t4OW1O(ayNp{LBa|KD8o;ab1Hzdx)wi7n%yeK^WQ z)yw;&tLp<18{Z~N(w@pR|7aJ%2|=(|aO)sR!G3GkCqv^xd6VoP=5IwT%3cd%KQkmi zdxQG`Iaq3W%|N_$g^F5FY4H76#ovJTCHw(OV*fp_duss_#488@GJgY7QJH;E zj}aik(l%+8EPJ#vs!n6ff>-44<{hTwY$^ z+Y$t*>HO78jTPXsk@mNLQFYzI?mKVD=%)^6tKSk*`dpoFeJN)o4er4~4Lpws|!?4iN>XW-ix<*H4I44KD zHf@?jf)DDZ^6YCrC$i-H43dMa_i0cmDoO|96^h>5$-~7u%5-2$Z1x5rH3ryJ{N^qM-Vcb2%q(bGwHs&ua1i$e4qm}DMZUVJY?{0O^eY1PAig(k!IK)6bl|gr+)+eN zgGK>r%p{-gR}F*Ff^UXZ~%7gJ_d(&@@DyMW#t4m9JpD5x6 z5TJBQ2*Bf=1PCoe4X}RF8Hrf4y|d5PCUK~BRNlzjiita3jKUf~&R~sYx7LLPC8qAs zeHl0`R%L&EVjQQ~H6-*n|BjzO1w6?_+)T-bPpX9)oE4KSole;LDD4IJ>wg!jjLGr-l+ouN7!kWBY;r0jyruq09$Gp8ZPePLjl#Rw#GV z?~{yE+B;t#Mn90ZO2YjYo>Q2am@xgoji}8|jCqLw56=J$qT-`s@OTx#eJLp=<v7K2ciM`K;MFpSPv{u!#}uv!`#!#m&tP*&IsqUDRW9OHNLn z_`zduKn}6BwS`heuK~-Ayuju(T`AYX_ZmVSx^W7o=>C6*p0@+t^$QS}KPyXpd@2f1 z^={6#)zsC4b6_y?lJfHMI#6C9_yJyz^a@BS!CeAL;q|Nv2~#w|T1U{mLrC%W@GGpX z?H=;HsDOVGAmE2TRaHGR0QNy@38D0H6XN7NUj$}AVK4ZcaYbLPx}L!CFh) z#tSvMAz)b?eSzuKB>>YEou0z~E%+O4DRCp$C+i#lZ@zxXUZ%_mQ?eB^h}V=?UyTwR9J!vyB}vy)%b)P`Ht8iUU#tHcSt18Jy=SmM|R(}8vf;0 z4(7z6Cyf4=_VX?R=to{kOsP=AIV>VV))Y2Ar?JZ{mFET}k6r-U0vu+=XU{MrdS5OS zhv(_Z1d+5;wM9Xhp(Tz%e{6+ATr;%rc&3Qq4Ib|tr-=ftrB}wK{&C7O^e#oAG z4buq7Z_ccaw$)DDhm<+;FyRC5;dJDRJdlV!UT;Z^%KxFCw~t0Y;hupbfP_`NooYnE zZg>s$@v&)7&4=iH5RtcC00?pi&KWw3cHQ{%Ww0k9dO%MQdB_cl5-3yj#xFtd*|QZJ zlgaGgiY6}V7B|`m)6L7-Ny5|i#1erqw4;YM$j(3B_k-QiT+7)oL%5^NrOl#_wPooOg_En z>%t`eZp+~^-WrYfr3}N5&;QM@_Iih^2H<$KevM``;JFEOsRFbRyWJ(GZ~7p@pOS*V#-=Y3oChMqn*VRBXyN`UlKLILHo zgS)%?41lY*zsDu@>{yKF`cKYw(z+gWu*{l?Cj9WZ#KEqwMAm%Qf+->@JEgAH){-Yr zi|%vbapP;9qTj{tc7*VP7o~DBpjBID$)nS9m zW@tU0IJ#$*FXWXW#W`mb^}-}(lAkmQ^%i=a|3HayN>zB2Ul-556N8bouw)~GOmYZDsbWmuCv)>74hM^(qc_4ZBs4ctS&v*D0ocFq$5Cb-Z%Z8|g zey5o&2$L$?DF*6UaB%+eDD!7|;v=N9eTbz=`(UQtCMNTuKQy+rjY8{%Y^1&koNRqd z!8f~GD$IL$`1bU4I;R7;&s*;uc>Z3a#ldTe)2oo)e20YD5es3mxCI81VgAHs4sEYM zvpac~G$UGmF@U>8;nz05K{3N$ulx zwGvVd0L+1M914E3C%#lF(EhkHLZNx?5)xlcwX{-3HBh9!ecLkt;sFYJ7=vm2F=b?P zw3YrD(^ro{sxt@97D33DaHOR(Lfp4m*&97|idLYgiI`tgtr zq4xpEhBuEJ?7}|>?KuBB)td3Tl|R$EBkAJbM($gQB{kKw{9Pz@WYjgMn!q7X`c+P< zOdCKsf-|R2SjdO(%7Bn=v($9Y<5i$h`DeT(^XD0s=87C#RhCb)(fa*;svb z4GjZR(?n7tBD!F@GNeb#sS^@m0&0vxuc9}y-E-NDS$R3SH889izSdgZmHF%DD@61? zD_P$kFq}!Y@&E?e);9!Ig}%=OAqEsJJF@b-V|2`nwE`LM@pwx9;tTHW$xM-rQLVG@ z3E`0QXGrPrJhQeyqDFHmb_f4Nag0h)wCUy1r{_GLNC*6WJ?}ynDFc3y5X%$m?#r5> z;Uhaal%3~|rE7v4 z$f%&Bp=;YPokWu42uP!hGS~lbshBMnDH5;WDODoTENfX(5)c~PI*E+#=_hFG@fj*< zw~^fa-3@|4*z#}j=>9d28|qzA8-WmyC#je2J*O1=juK0HdZD$BCtZ$4%T(Fre+kPA zOQ5j6K*6Eda|BogHjoAl-Tk_rr+|Ww=5oTuUZ!R~c6j*XY-y!DsDkFo7>D0hvVOl= zBv3`ZSOEVJYfACKe>k(Hs|%khCf3I{=-1U>XD+U6$3WWkAqg75|Z zQ?4JK8A1Mz>jrSwJ&Uz!PxzwJgs$+^+Cq9*fR75GL3ca?^3CAKOjw_YKnVrqq(<|< zDqp>3Xvi=P` zZ8w+5V{yykrlf`fdI5RMB>ce=vSU8o;r0xwnGG5t^yr@bN}nLk8%rua;7{dB-~pTc zGdIeBa_ZtcLPy93F;Ta=P&2+C$Z8b|)ZWaH1mpTjOv2&K3<5?#q#}bmXdzjWzBM~~ z!p%9bKkK;Bzoh#Z!*1{7|C2Y-0ygjh6{ib$) z!1tWGc>YRNQT*I;SzvzT+1@oYk771TEa9yfg~Rf*%O)-lQSulUFWScgHCl4mlI?8w zhamlf7|a%1%(6A+dbpAIpHYn$c9l&~si^*dj$I#uvb5>90Rsdcn%B<=o*U*@syq|? z-&q~6buL;z0p!=X*w@FvTu&Z}cFYeLt!CdQO|HuggXLs7DqpV;p3~6q zhr-X@9r-lUT{1rM$=uDqeOR4QWNWXmLGgQom_3yf~6Nnu#dUP=b$tS zVlf%rvFQt`kZ35cQZ77UHB|{J&+G|LVOEz2yga8jo^bKN@&-y~vmcCOW$sX~o0`ov z=p=r*8ezB&FDpwfl7I*+?DhM2V>Wx}xCOHR%CZjT4=(@m=9V7w>{|vT!b!dDE29#R zkC0k#(uDosrUAW$YP%D5GYoo75{vlY362#v;e=_cNk1~bRz26dD|-@@mqBh&6JIAo zK zK}8iHA9ahSgKuw`@+$+fV67yqM|?MDPBqB_;eOM4H9k0>()?&%&DX$}LiIK<3Hn5R zh-&N*U&|psvK5|3gz#|NaA2fd+h7!p}M%6QJ!zi0Pajo7O^p}?*>DO04{<=xa1a+08)yKHxUQbjW-qJF-Cb$W4|s^bw7b7? zmP%lPl6`K7t9LyNnB*}5eL|Vw&PT%yTkD{FasBa;oMO3fKXpU>&yqd+i1v{!hhMg< zFdWmGY!#XQzQ7hrMB;dbIFH!fHk=`t@(xkk_5HR8E&+P=f#~H-ww}{k*I1-uD~8}Z zcv@-yz=&;L+j$QUi{%O#Ss@S&F*X7`bn9@kNVc-7#Ew~^A=lK)szBOIKI+Ym0*yi>1s?hN*Q^fw@YypX zWQ6JI+2!@U@Yr&W?}IEgL`-HSC1u#B%|7i*BfZc%&&z{N(A~DFQQYY|ZR_rhrOQ*6 zuG0)#s`q^qG_xl4{S}L-72=mzllCb9V=Gl_P#69+^Ov9RGPGTJ5-A{kE$wr5 z>#L3w^jJl=_nyVK1jfkI@L5@a14|DQUr<`&LI8$n2wsF9_UuzCe=V>&q4$-LkN`Qs z`qtzluyGj!_J!SvK$i1;lJ62&?@HYr-Cur(emhR}=eFgEcN*GV-PzILV&UrAuvxyx zm-gJ9k1j2RMND3Fz(^&^2E`OpwP-fJyuGK{r#II4$J+^cgI=&25wzG8`DRl={DH(04XVen{l{{$!mMSF3s^li#4BxJ##bz0vwU4_gh- z4cDFzR(h0gBZyDU6M1-_DaZrM6&8BfDu>SFe61r15II?$rFig@lU$F7cqXVJ-8aYK zW0ZdsR)W0sAYWv#oMk<{YF*|nF$s(tdDKISO8BUzmW2Q1zb~CEn`-q#R3G$VRQ+aF zR#rIf?(RYXGV#>(3j-G?@A>Xr^)Xn((;jS4>(cdr-?)lpj&= zHiH(Sl(_g`lhN}jh;F{dVQd}hoC=(_w9RfRHu60Rj6FEi?z44Gj^--#f4TlP**z9(yyZh^K%AEF`N+i zYt_oWf5j|dL_8*!w@p{*+YFjseOJ1{<_Q$4s%&w{28RHo}tHcilK_dtIOi@Z8Rmv2=P8AjtQVj21=srt5 zrUt{zqg-bnYnB2bZby&DcZ5+fG53FFIp9>YIf$P6g)d`CI84|a)+I=}xe8tQ!9qxF zc@M^^_M-JdG9C~K^2)8?ZyR0QcCat7WK@LHZ4)_J9 zsE`FGdDo;Ydfy-7m>ejnaRY_kbJlJI-d*E6leM<{3 z;wjKQ%v5HKn>#=DlVkO{JMPwz$}{o<8sbynVk0fqYXWNIZ{guyDZ1r0L`+DN6l{)P zwhgTI!Y(6&cz7PyVj(9Up2WAjZ~vf0<52y}fEwY`qvoxYxDd$vgrnYWB(Nse-(#Z3 z47zSlEwpdE9OA}nh7{GP(|}H zG+^KO^3^LzDsPwHOw8W8n9Yc31CUc9FJl<2Egp4jsaCpuzE++C=kE&?6uI|q_-ZpE zBcn$)IK(_~Zm5BTg6^r|9VWV{vlAg=C~3eVPV}2b_7Pk*r${O~ox6Tt;&3tf6?q_D z`EnoU*Ka8AOvj|Q4xNKb9b0DF&QeFqe13(YuyN;ruKU&Xb?+zo|7yhqpq~zS`U6Ba zcC+16RktV$9y)@%3nxBmA1agPDQXSFl!7c|-^PA!>)&Q+0hhXBuUNIHQpi~Os-|+hPH;>+~fk@+S7#1EaRqkvKU1QacE|{Nm z0;EEg*YMbEp@>=h?tjLqY7F7_mppwSrB(jbvv7HK%*0w)ayOLfYVC84vMcSEME`^k zeLOey?zYJ7PWYL0;k>^DOzBLo#=@$j@V+9Hlsst)%Md_*9_loWKhp+ihZHEdg_YXP zP2Tlq|AtMjS%n_?R{~tDD8{cc=Sv$+%#gj23KvytHaIF>Xv{zBS{ZUdzy8&yd2`=L zaIVxaMf8PWlko&WKbVSu0mISN6@}`x zruXOM#`*idnDW_7QJ8|_X})PK93^}2c-#pbcm>H_Rz>tKC3ENT(KYWLe61bd&waF8 zL)60LjOg!M)`EQT#xA|o-z!-PiNx%7ZI45;qeHZq>^b@Qn&30W*VZ<8AkUwH3w}a5 zE~-Jk*)qN%Wx3A=ARLx+3uWD^!>wN!hiWxWSk_1S2kUScZ@sgBY9Lx!%W4-Wrg21R z8JD9;b1ce*e)&M% zqd^$)i-;!xa~@*V(}HnX#p?9FFe+m>-KT4JRzQ@E->uNlnc%zETSJuo8y9w0_*%7?KB_CTSQ4Bf!_252gKJr@+r?N>CHyXa={+pU6t^O4RE4bTP2XW) zUa$9Bo2bZ_zK%kr!@etii}Z%N#8a*d`vIS!S8ldV;SjIshlgX&#e)O z2_I(lT-YHokke8IWp{@cDejlsZo5zG+bbmdRU^oeru%A;qh zKaBjCPyXaC7-LDbKz=2(zWyBm6JWp(ThXVO4Yabfw6%w(d3cB^J35Tg2&2~Nk1oD! z6>(%x3$l$FzuMD4O8k^Oxk9gu-WMNovay``F}prR5OufdOEDLJy`$f!z(S$6oc`rs zAK7lV=oX6kf31YcMp;}t;VSmwi&XdwibR>nr^CzqK(x1)OYQC=gfDKHEFc$t=0_|o zJ*ueK7N>{<(B)5n!)9!X|CIfxF991HsBRPgSdN^yrS((}m^`to!nE(h!I$TtIN)MZ zv0n`RtPUp?(4B_)61uHD7MiGt|3c0nnRM2-|M%U>RznEZ!BWmjqT?3Jjn~mKmK1aW zT#Vfa51sirpn(eX&_~OI8~rn;#yhA&|CW|2eqWvb+xlxvW;f#m-?NWRE9GZuo;yYC z(SSi4+EOWfvN>yx}u=KVxJ=4lsSzS)<)RFF!#1-z-OU|?dvD(v1YFM_%!1@_f z7$0X*S~K)1gVq^#e#{=cGMiS2ol}qQIV8fuXQliQQ(>->cEgMxEWP_xcTz2tzbs>L zp?H&s-{(xCHmzzuX|ZX4t`wr9qXQJq@_h#c%D`7*H{ZwSU&ULjT&6}+zN9Xfj_$|9 zTXi+jTbmZ`>5{G9^A#MKoLF(a+acTx{b|qP^0hHI8c{7=D+Ytvbjbx^XY^E9$X866(Fz1vS^}3}kd>@9UeK_2#SiN2`d_4;#YxvG+r(s+^O zM?(z@j|2Ic44WoQX-i^$g6web;~~q)gH~6e?Qy=au)#*@4o`thh%bNz{|Gw#%C2=$g#2}ZR}0!{&jB%;6*ar zl>g2A>%7cYo^$fq?>n`fg4%7M&VTj)1TGJ*s51!Hq4%-j7o89>GHP3rD+BnNCcXU_ ztxmmho{~=dtMU^QI0}gQEb;#8I?bsI2DQ!)0Lm3-0j4RN`6vyGcJ1ooZadD$gSqPB ze(ywsqOKxC&Pq*&zs3dKkDj=1EXGjB3_1xYWvRy-lfKU!E7#8bgCT(5hDKR&cMn?_2K;^(JJ@ z)bM7#;H8=M#$0#~Q55X;wlFvHTW_^9oCzWx$%6}d`L_q+Ha@^jL8L8zb^tk!z}-Rp zq0!d!|6<4x;6~)C6q4Rv9&Tj{dM_ZKZwstxEHBu&VkrAlJm=iVhbp?W+iBcAe!*oc z%(XGaIQ07cY#x0l>+rSmVl7B;bHyX2=FuBCYLmoQl0dV5ZGWHH_#)J7wqhIGQgbfa zbamD27i?GWMpY>_w8Y~)?DBft=*pb*MKflIPf#>W?})C%iXep_0Vh-D&0kKOxO~iG zZoPT8t9_fBQ(`da$ieL->D#vwLymAavQPrQ_@AkZ+q34sqU~=^bK&hADrbCS0VIr&H!G8axNnO zbuKusuCC-^QUnk}mb;z(LbA!BX2Mut-gKTbT-4mfocL0qPU}90x+9lb?ES* zM{gmu0~E4(s$#|@GO8Wwc^qnQO*8Uk>-jP@d^^$T_f6P zxH=bEHsnFLq4lUl@%khY`(Tdl-7nB5?`2Y371~%^JLU0W(kWZtk60>9-Fp7)GgHyM z-N2kT{$xTFQ@K{7BJ~I8m{OxnEx|(fZjgxpR_ieo!R9J8c`~b0^8y%%0BaU0_51GG zDr-;Tz*e`fOOMN}9ZLkrDM){@zC?ky?7PDGzi)VRBY5Ca>DC)l&0TbDk}7BCR9b`G z{+8L3feBMCdzzqF2Ul`*c`xf9*M&W5t#hmC&Cfy&X;gQlC%+HhDq)M z)2eM>u4qQOEzi5pMM`;QFr{I@Ov|$Sk1n2H{2zon@w+o@X|cv+qM`hmV3`i8CPLNlZcCYl>FUg zz4y(vfILxnml=`gZ6+iT8SDQT;l)*;1cPVuX(Iw-XRdr!W|nhhR@!CS#1k;62O~8_ z0t{krx`PFibjlCNF6iV^jX<1L{N$?u%B#oGM*<)U_5r&ue3#YKRMoC6ak?t2K#HRif ziqo|d)Zx}%X!!G{nnCqD6b1Xc^=ys8IB*aH3V?#RiL?sOOB>*OJ7NXU(g7^wz}oou z_^Pt9w!S`eX=!QphpLhiw>#G^>x6^^J~peYdc{e}6}jd+OrSRfdFd!vG6-a$^Ks-YmZ$ zTvk~h%;%3kz?!iGB}v8P#gb2>RZFt8&%!EWbKbwV9}KNoR$jdeilV`CcVN639ET$; z+7tT6xzk>xP5NYP91GG`Y2JHDz`b5juXWfkg5iUHG#?cDEhq@lz|inpXy{9J_88C} z5)l2ZTrVdu{0)j z`m&~Q++kc88hq`av`^H5eU`SY;g9loUTv|3zdO^UZGDvOJlkn(W z`w$QIc?n=mdJ6yvM=7X3wN&!F+#l28M(v*-Ccob0=9*KUC?zFVA)`$UrgR0QtN;Jp znu4ir5U-2tWdqMDYZ5Qj8G@;WE=z`Sc^U!7Wri|w)REZ=C5LhrhEg%g`#IysQ9-)M zNX;sP;9cNMe|5DM2}?**gPIgq0X#3T zBfebd0i>}IH~{MIdzg@kz<;1>^?vjgKuW^S0tbXK0un0vYz)xl1b1q1(dBZQ>W0)E}*H zg4}IO&>0oU(-rCOtDc*V%P<7o+kFcQ-oWsW+2a?VvqhNVj(!(8nCjP5pcRb1876c4 z!wBa%aUQvGXe8RgxGx9{8rU#};sN4l{Dw&@pW6`?m?-JtRSS@$Y+JoT3|nCN=Lp(H z=0q$h)mF2)BfH0?r8YRP+MF$<&`C=wDmq4bB{v3RxqVuHcg_Kgh~Y@K?9U3&8bqXr zrAn~_dxPhIa-2wd!u`}IF09P(T@u^}9C6O1X>qxpe`PDbS*2&i-HA2Ulu!Jq&s;9^I_ z3~ZlBq^0|>z^B%!^SQsF1HYEl0pJP#ej7m1<_;Xf00Xg@Q7Mk z;S$k(@r;SURW5u81P+*=pPw@UgHnxvUW=b6*n(#h8b1@6HMtg-mX_Mg-kMYx= z1V(?HGp;+>nd#EV6~P~uj!@Wi_PZhf$_E`NOjJaq2Q*Tvyyn2I#c11f{aWwGA0xS4sA%>-8#1<&{G=_`Raf_5snn?U0dT z9wKC`MTx9O=0f+kcZRoxGwpWePo;%z^5sUN4@vV40PGdAWk~Yg`wCkY3hsa6{`~_E^-F`w!1?jz$jAsapdz5x0ROcca7q_Rfu!pmB!AZ?J_UcZ zDU|(X1Dh z3H^vZgI)uEr^1hW_Mg0vZE&$_d{UVBAAYsc_4Ci&->Ys+CjJaGdR)w-mN;!If^H5S zC#!ZOg}|`JJ6Ef*y1Dq_T++IIDtg`h-njagTT<{pT$GP3yX*zLu|MFz+lXbiECz$j=^E-TcdwxeSpeKs&RclQN-0dFvGIP;#1iwj~kR}}%S zzlWhI&*N3GI7J1=t-tDQt0x=9gx%ez!4&~tiGnB2`0OdqNMZQ3j!UM6dXs`<)Hte?8%}E#35pKH#^b8rSFIQ zF?y!mS!r(v2S?APk}jATk$kq!A4^>qM--H`DSZaBE>nd?{BWt>zV|q^h?7tjMpViQ zq(Ws4FnF)fhl2X`ZEFB(fMS+p;$oI`2(AQGR-&Yw$)=a@d@}Bj07Thke#?PABNLms z>is2w`lI)BBNY`>vp>$s&cV3qu81dVe&8KJusx9mgw`NO`uq5Jb-adUGMJ)n31q&? z1qB5fVCr=o4mx@nAjk5of-*NGGIFT5p`ihx`SIa)BEZ=GN$2wk==~|ou94Ob9?jvK z<3=~GiF9~8%+|V=Us3h_utk&#qPHQUe65FeRFy-t&sXudQE%I{T~LrIPyZmojen0@ zF!$>m(Df^Cw?o9*hth;p=_)OxO;dNFc{5tehsEEpUp>kWq4u*o`w>JX(eReZmYkY; z4ee32%sI-15$U7|S?|Oti+nu;eubdjV8TCwvJ5-wx4G9nJYHF`L_5rKA$hfZ_N8V^ zB7U{E13QTwGtyh=bEDQak?Y<07w8L4!9U}kuONznz>Zh z@R;N);C2ciN+9+Ka&fH!XXq^z??>-BzEqGG*PFV zpE^e8{a}(}$CP%zBR;%pEGh5K{Fk9#c(BWNC0#ASJWda2ilA;q97@(yYc6*$SEmLn zV=mTQ35vwUxMCHt2}F#*wCZ@^M8I#4k_tQ9N>X@b*+olxDb1{arqTRcq!`~d)Faa` zF{F1rkSsVec5Ga~eNhlg3yQuHj)sN?Ja@MqAD>`N&>uhsIr1N1v~%zWki2YD6BAXN zz+rR&L$t+#nyBgg^zzvfR z_J;j0Um{p04pDHap7cpDqr4(I5p@Y|iya9Np~0aiq5sD()0a_RqqITNZ2gn_qDZ0g zBtR4lbDGvVIr+vH1$fWuz*%yw%Xic3c>G({iaO8pi|md8o$_STdwG2RL`-3M_4m6r zC)2Q=sQK`4)vUPhj~~1`y1Eumo)|`yZWIa%3fG6stA^m7dounCeh-w1l!xVYSziVG<2&Z!) z+Jt(^yyWYf8OQCD4OgHhB0`;ic5vnj%&|#?goLu2w+^9DYvPXcZ&Q}iBg)sz&^5GoJu`>a6iF0~dnyw1)if9H_=<`4{KP)&0V6R7@ zeNMRre3GrO@6YLM2+J+N;G1a9#cvD2PRlBr${^-VINW~vud8SR%p=%A zGEqYQJZtN5=MHMqq(Z*F-arHx=Z}vrmT_DhtXF9@69WWP^tF4hbf*<*!edLR6bNV?aQk1g1qofR_qwR@?!AUjBFh z{TItqOn5;;LZSvXnAGc7C^r?=vYUy?<}_fQ>lVvrw53t{-r2{&#%f@4BQWViFdl#( z0(KHT*QRcj6$u1jaUQ1a*|PB;yE>5`vD=;#gq~-G;rMw|ZE9+gc{en0$pQ)A4M>lY zgnXOWV?;9O-#*0SMFp&8e(uKJxHy<;q-T+P+e^%*eR47fuj<;v+?Gk zAKENdR2SUmD~>4^xBea7*A1LT5?esNe7|MC6iF(roO-S6t^V-Q!lSz(^gLbVv-O$i zH=Iu0XoR41LTFWy(dK%1s=#i4S<4ck!;^s*U?CcUvZxZMZ*R{*Ca)_5?6@OAb@~qe zX>Q|n^8&Cyf4BuJMFn#Lm4VY57y;2(ALlC-+%LdUIbB5m!?9PWGh z&gU}tJ&)yOFN>A(rdJS92Ju8_Iv#1#o^$X7)aE#&G8-#m zKIvz(vKX}tgS_z9FFypte;O_;H)_FW(ey;N)hhLB(-i&UqEqWY3(l;&70&M=!Q1fi zt-;!NGcy&D1m9WS?$VU5n2d=Buj*`lR|v>?_1068g4cIOV72Y~4=B92CT@XH7_Km? zGyQ#_4k^$kB?4oE{phGDDlo_in6-L`0L$!dpzhw18~ZJW0k#o9w z?J+0KB4({$z1+uaGIyko*G#fISH6G_yZ@g!a!)Xo%R64&4uL|g58 z3n1n9T{3P9LIaWIy7ZkN6ZT3$GKYnM^_b8c9qNuiv2v4QCS~X?HHz7obca#0gp}0I z3?NHCOW5t+$Ke3T&G)#`QjkBU*??612K2i~O^l2n5`nG4R#tn`0Hyl%+)TR}{ENjJ zU=qUt#&!5U6*2)p@rhGfS!q2BfYXYlbOvp7qums>|;jW*r?Bh_~%Q{e6C~zIEtis{^{WY7kYwQAW1HiNq zhF4Jh&{bMtfVX^!i~l(_dcapu`{SHUgIbQd&EYS--L=fi z(R8&u^f|`@M2tT@+!~(pf3Y(b&KdC{I{RLB;fFR0*@g@2L31a5V2s#X zHww&?NkW}LG2H(+1L9mS_?*1%z&98irXg?z9o~W=x9 zD3i?2=mRLCNKfF<>gMKT1sHQ+{xQ=Y0CmE1U=~LHAz&exK20Y0sq494`5Xe~^N2m1 z2wp7*(zV@XWMlyE!f*hzXnACMUT&+-FLa7?-z#=L?@*44EiAwVQywBn1ih+oU!Diz z2==fp6v%^ZBI2j^#VQ!L;bGSD^CQ1~gS}1lCCyO7&DFQaIdX(A$jqRBID3zJ-T|mI>G`x7>2u%o88%?#`Wc z66wm6S5;9c0ug-`u$1_B3Z{Pz&eqtkC4ieO1#$&`%&Dp&P&deBT?5<}yCthP*4J#I zU}iSBMG6F1qZE&M%*G#B2F%~Z50~~9JUQlhpXGvA7Sr&1x(C!^CKr7V8*#X; z?+UdoVp)zx1G-;BEF3)d~cjY)Oy}jGF;A*tV2Pm+lAAt1NAD1Uob(JrgA^`r% z4#q`2>8|snBqVTdEhajIsRj!Kz+vX^L}|f}iX|sUE6~1`3cEQ+!Js}%^S&Sf?xCt* z6v5^d_fz{Lz{@jTZoOO8Y09EgW!i)JtvJo?H=lv#A4AEO{4BOc{uE1~GB?UW*8ocPhy{iOrh}We08D?DyXCU( z(q&SQp{64Tpxq)9sF$dOigvggoi1*SjYIgLfuU_lh*W4K(Q!4pQgwo|T7v2XgK8)$=l`1sKU*iY4kusj6$9HjPq5#$T1-VmVacu2%fiRE(XiT%zDH8bglI{||i~D&${&KmNa^}oA``UZ|O7e6gcvCZO%*F=stw{eqvW-pD{_L#7 z(85nXbcR-9Ss-B6pj%rDDlo=WSJ~Dojc&6{MiT9+jXZm@aHr=elv#~36r#J)(_c7 zEssj5v}%2NLC_OBBRx$X?dnfhU^<{Y4&wwGjg*uy{c=V=zQlwCLe=;0<=?)QDW4`FBFY=+>-+h%?O|zrKmf;D z573*TVPJ@GgLK8i>Fk^&OflE88px=6Sd1~dcs?xI#_EkqTy`rJ4M62x!I?OP)uZzgPggx3`f^m@QL51H~PzjwbeG@Jz8LAYAd zIUv@=W@aA#JN?2bT7BXOKVkl(y__(JaRLk8vi2*Z#{IW4FXl&K)qYgkKzY|BYR zN?_(|Z94DkmWf095(WZ(09^^3GGgqTaar5LN%=6;cj_$SYtN_I#6Qiv_6M=KXs1Zyj4vkKE2nrf;Db5{& zb-s2%-+;NqCkK3LVz6x5br$31Ms$@Z{Gc3Uz>Iz*+J}&7%P{8n7Np_u0$_%E@o{%Q z;o41bYbfK*(_9G_a7+DdZHv-!avLg!lsA+agk5r8iUMDv)i3rgGHxa{G(dmV0nqS- zEHGi65Ym9Wj_2TEBwGB{d^$Gkv`t|lp<>KFajUgA^y9fHcuLS!8%i=^JXB%?7yo6Y=VT!|6LuJ zD-oV-p>oYklm?tXhY;&c?DU8oVXA&H#QDL(!zxfWSLYz*%$zq*ZrAjVO?|ni2L)Eb z>%9`m79d9J{DL82<^$oOkTFg|`Kw@gUQy4}2A)~e8&18LidII|OGVO45&k475{uq)VrDK|DMOs6<#ulm3@YWFAz;#4g3kp#mK^i! zZyTLj32bVPx8vCO8YG)B4@3;Di#i*8-YKlH(-glxA83~-M4OnJCY~Q3o8x~o4MbNi zh9ZQw_dq^aFqL=GzXPu(i>iViz#|j%9;BYkH^D7?^7On6LPT<|E>opHWydvO!Bfrc z40+k2Dv6E2)iIZEQXF&9KsRcMcIii zAduR8e>$a2OY04+VSV{{c@x0DVEzai=*M(uk$+-boN;1Wk^nxAMB&_s7ySq2&Li)F zm&+`o_a;hRztp#f(@SXcJ`+H5iE$=b2HbB@#J@PB9e?&`t9?Th6oJQdMJU)7}QZQyLN?Bmgsr2p%7?F(lW@NhHb1yxeot1slqZRu-^JEPKr*4MdVg?*b3 z*OSY%fi6AvC%Ep)^>o6gslX96o}46UGCCa9Rk^1>r4=^}yS9ZWy1Ux38mU|r5i#*- zV|#PAI70RF%x`azCtEXc8}F9)XU{SmCyS%!*N-@b14Ol3$<#H1eRsba^IxgPcn9K6 z451WD`$w1cgXZs(D=bQLxF% z7JeYf>exJ{_9eU#jRAh(@D&an-6h8jFPQY+9oTg}7nT?-v)aW?vA{nJbEu30H|+~p zc4{9YtiES_n|f;8=(0YxH$^1oN6*5!Vem5uwWeEe0OruD>FK!&VlTGH7aMUNoV&t< zs4_FlFnXT*I9qk!Bkot5~W0JA+No zLq5+t-(9%L<1f;3SII8ve^e2D#^z4rM%Zv3y91%m|Xx3G7XrrNSgqS~tF}+X+9qe)I5?M0-QV^@#Ec8%w5<`!{M9d8Y zW=~(^$u(LGxTIaM>i)a75zMBRWv-WnaaSL0EJm4bTIY-OAnG%S#dJC;4~o+&7$&F! z19+~HEs2`L_b6{$7V0fUsHg~5s1>WkGp-&4va1uuY60rT6pjr#;~{D?B4}>8Zl&>` z@kCbF(#fojRA(QbY=jDEWH8|#eVghgi!5v908K`e2{pBGbycsN9Mert>~n885r~eC z4xebL3KNwwTwF#Xz2n)bHtsp$%pN)?wPY$KZin8XHvYkG;VQ>a>ZTKdw(O?oTTYDo zp;Mi8o0ev8$_ON%s|w9iNs4qCTS=L*i=rj4T6&x5`*1_&-3lCw|JZLtO9?f2zzkB_ zacNYmOA!MQ#|^HT@>?o=+q_LD2CZ1pDRA=dj(yn9d`G->?Sc3-B)rUzX6xt#@nRYCnaEYBsr@ z`1v(^;v9|C{_UwuWR?AmWz5w3V#2()L;Op{%n@nt5KaEv%*sr|i66g_5f3mRk)Now zvVB?>)`MQRc)C<)`s~RK6{1sT{qFS#Fkyv7HlO%h>0rj|m@mvp#96uR$x{1;0z6T;w0x`o3>$x9h~M5@sH66(fK z5*9M9<;qbU%h_~@akp+LgP)t?#!DZq2(x3hw_oWzSx3&u2sqXG^70A72PfishU-!m zm@$&_65h`T2H6Z^pnKSLwFMkR(KB$vn}o~@7Z%H&`+CbWx!sxu+@p62z{hIw%kdW( z_^Mk_f3w(RRsY=LwhFx>7qE5f>h9hHEH>!lRm)=#z+OkKKm&{sglq9+tOpiG{e}M> zS}}lV_P*9qZ797ZW_y1R`2qp`LOh#5Wf5VC8BTWn4}51tBzERm&`?yx2FnYKirU~x zqVFvNJD9kc2=oW5S~%uw*mjwIsAr*J0qly!sCuGp$tX!qSxp2r7lEH_U!K!-rt-p_ zCWv5i!nwb8VHZ{)7_?w|QIz~8xr!rW!xdS}e18ZGh{^k}GM1w6=su%#z z381KAt$#Ch9x=ch7&=ZIy`f#C?-D?3gn`F!k;G2?7JBnn?NqKs7{348umKTZx2xQ3?e`TM-a<|PYBcwK`xM0;ydom$6V zrg{~bO5Y?YJR&-xhITJ#LDd~xSK%rMH$-vGN=uGQ_3q@Z zMn>G5^*wE5ZqSM1e*e4Fc?3`b}fGEFUtUF?+?Gt+_{#y`3@co zkbhLOph%`B;8Yexk^@T(c_k%cAnz`pF4Dniy2tR=T~tT0oicPvYK#v^yv!KdZ%A|w ziuJJG5-QGCOmo@ercj-L%V)WRZcjxVjDaxWkTTEO`9M-?* zgUI+RRwxJvM$=e3lsH^J2~{yG4mhE_Mr(E6vq{&mv}H!Tcmkz>TwnI)2&5GtI>#bSHj z0g5W*nceT1DEH-ria$_yk*{gt9MRL486NWX2Bu)m80_CL4)6&HdA%D2&` z5pE@3S$wqvMyErJPs6h8AkVeVxmyWcS zP+E#=Jr>BnIWRmZr;y6`5U*T@N_z@fa$AoiXVoZ6-`?B1P1i3U{`MA3_ExW7zwUV= zdF(AVUbO>;6dMtA=Lw;L!67765`poBfCj>-l#UB7XYOCe{9~+c=n+vkCw(%yC9r8|0VPCMC)bQ814M*rh`<}OaU9A;0-$S-})5@qp`+8~O z!^!T;bM9R2%utfA5Ik5820y=g6x;*76o-D(b+4<(=g&2(;5pd2xQ(ec8xEER-doFn zu|W>PxCg(1OzBx}uj}J)fw(sZNCX4~C#R?ID+-;aDKs`&RnbfoZOnNYxY+#gagMRO z4ASNJb2}Zs2OH!iHL=EN0j=9>+@LuvES7FwNfB9%(&qu=RvCCzZN!fuN=mW{1;eK;%cQod&w)G6X1 zL^NX>bV2J*rVa#S;eNIzRK4t_jxuX6f`3a>3M*8ciHDzE_&B?^MeX;g82m=wQdlYd zzI;%qXfhGvQKG*D_lopZ%R!j@+e!Cp1=c%Jjd(8QO&H;GagcX`4SXvA`SMg&3anOn ztrxCO&N7;sZVw_t&Finm=;!QAy-;ui}4Zjtmop?8(k?ep_6@hda zJ9NK=}k9Sem58o1BZ4l*pRTFffd1l>Lh@GODYH=TMQaJi~#BAx;h zNy+$V*~r`LzwT$3=(KA zf<@mmySUmf&Smb!+osi+yHaf^W9zcMlh>P>?_##ZF=qb7T7(bJh2C7p;f~D>fjC4@ z!AJ5f?q`ug$N_%-Ixq4PfVl?zv9i4UiL#QC?GtaJ8$5?1B+s7x@{K!HsQv$305D{x z*;rdEF)%W0ZO*v+H#=o{pg<+nso0_e6!ec%B`8KZn#f^)7O#FbW)SlyCZWu$()_WH zey)u|YNUaF{|?@=5$eo1la}SJH;4ADq5a~sU?yCM;#}2ygSn9=N!1azG6CXG3-}F7 z;q?B%_wd*SubearR}qsiqN?t@Dy{xPYBSmrFmzODy4<37KYt(gfBXW$p_JZS@K8kO zHHvdCS42C3^i*K?2IzV0?B~t4v68JhJ|f`!84Zf)v_5y&+6&iHbU&z_hPWLyUp)n= zlL^`zBI0tHAFotTxwyzGf%3f_vfhJ`)YCnNYl4IO$CiLDdOS3=>EQFA6syKPK`0N6 z^*|D1?x#NzED6j!9bHQg^~&AR%5ybFQa+kGU|DdKybY3Uil~7exebtygBLdkQDT5_ zU=09s&gUNgYQSMX@f7jx2@M?tQ@6TA~sW5dnN4dwctazn%jF;4eHqJ@vG;wI?(T zylb&>4-XI97Z)jkSuVi(j?d2r-@bWMoE8`7sQhIM>}iveNhww6pFhv(2QF;O#$ZWo zR|jbS>v``P$Ko9$SJsU9qu6Scc7T&g9JYb1)H?2t9{%OuRg=rbqZRu7?@b7SX68m} zzCzseD+>JSL$D;u?-64AZ>P83kCUbTY~3;!OvScLadjs=g;{a-O#%9W~4eH zoWeDDy?dHJV1%yX zz@HTYK>ALwolf~TsR54mabQc`X!K4xu>Ac`M}#O7lbS`Z(-+DJoB>{Vfp>c8S8FW7 z==#>2e!57;ShyB8>i@$BM4&DrDWw8x`yadDZMn@ja1 zA*Fg-P~`uU3Q7E|j=6#NDy0{T3VR z2bz(`h0}~a6X5@W06d|GkON+U*&zPwSBB@$pJM@Dhcc>PDfmfDocz}-l9HH6UsY8l z3ZhlSJ{lYMo9$eLy(U@Nuq{-j)?LIXCCj46H`k#XjP`SQ7%6zsjkf7MzEj)?Wh*3^~NzS93%S8ky3&&SFsD7sFgCEDrN=!4J49ekze ziS)`WZ=i+LyqCY7-VIH?WTjxx4Y@`Ul)XTHo1mjZlse>PPm$3#*#F8TzmWCvV>@^d zo@72RUyj64JCc6C+Zi>BN*5KXhyF?ZcX>3Yc4ls3vYYbyx%1$rr;d|ZkZpJ&%}?(| zHs5&I15_~-e)H`QjhE$O$`qW49o!9Z#+;v$xh-GsW62nLO_BP=8%#SKMfw)Ep(bn zn75#(E5CJ8*FRpY#va%TE7ZJ;)PP^b61YCczyAt9jcL#R-g9lSn0LYfB7nw4hD)F2 z$0(>j^@Bux4^3_>w~s- zDl;Qv2&f(RNt=&NO`?vDj=lZ;bOHibUym@611jq3>cELYiiy0tzYp?qyzeXlzGIsX zo&;|o&%g)srBy=8O}$pvjT(34>*pTLOWm_=zombb287|8eir;mc@CK`vDdY&|Bs_eWSkufW=HVebt8;3=}Iv2KCs?!H|2L+{Ss(Rx4X=Xe3*%-n33jb?Q) zaGl~d8=`=<5K%*bFAxMcdUIO+5yJDsDX3si|}x0AKfR(u*KkPkWh>(?*-@aX8r zV$UK7cvy(RCqe{$tnEz2YRYkS0fO(GYZbj85nr@`Eb&8*102c4ONnQeNz?dauK7#a z$iy}2(Sf3++t3ti`9pxB`+I3b5%cHBUtg9`JfAp$IhcNri~L%!YJ!AO-Y%r(gp#z~vKe#m>eno;bWiMVm8H?1gsu3ro4WUQKmu2QGSw_W~O$7m-{1+085PJ|5g zjpC0#5(Fw?T=5q1(?qiZt_~&SDK{4^=X1gIrU7GhoGx<$ZNTM}nb~mN>1CPI!~KoN zSWm%Xxoq?r1|l4m3Qms>bPBlhK*fa(o;=qg5Xv7(E zNa?*{ar~6qpG9PRZbPH&pSv`3lI@3@nukbwO{*kkf4FKZ{Utqn`~6o}VMq5*@2Q(>^aq6=NtuC_{ToL%Nb#+%s;tBVnQ95_I+w{HQDO_cU1dN4uRR6`-eTRp#}A~J znG>RCvMFaD{Vz_ABUzi)F`DC60#By!B6f7y?XqiGKez;DAibtLq0m3dK(C++C@ap{xOA?RFD*_@0F_k=obWpfKhGre z3jm{LwAM-kSf1Gdtt!K785wu2vcFSPQ-C=Abgt(mY}eb&yQrbIfg)}`Q5Y+H{Dem0 z(E#cZ>Or5Y}WXGIjJWU_E>V$8kT{H20R3FGXfZYqB{3B6I3F9aX%=W9)GtfB6d z_;l)^Gt=Hl#L!YDAkl0Gl%*DqiP^jB>xF}l#ell6BOQ{Fkx{6chyLo-s~%ulT))5E z;wuA)r(;iYPIFr6et_`+_&-?L%S$(1oobTJkV?%M28*!Pw8rk*J1CFzH`P?vl+^wz zbl*n~6*Dr$?<6~D$vlM!JkX@QA5vIOIql!AVz^!o& z(Jr&^Z8|Q{tEnh;Dms=&r0D(SEX>K6tcjg@HG()?so3x}F9>ld)(|@;kG`d44bF(F zf)B|U6G=Lhse&?U?!?AUe`-;Qa&fWg#bMP#OFJt6&~XIo45^VX@{30e1YCyrPsmyC zHTD?;0V1^3Vo+m_SKfR%M`>&V>Zty-vGIL-(DB|(j_mS9%Rh$d(vm#}(nvpv42kI8 zKV4V{Z~>gXlDIywZuu1;Bjc3c@hT0m;QKNgr^|j{r3P1DhYL zG@B6R0L%#IR{55kH6TGZN|X~X6j~f^LQK1TZcjf>kxEC~WoSEsyudV5s095W%+^1a znLdxsz9DVLG%`{uNtBb!rkRN~A6K)yl}gi>{@ysHAOSZctC^}Wa5upEqb>hJLqyvP z9$+Qzd$~NbtEHu-4tTYKppdSttXPYPG$sN8m547;(Y*zrj-uz^()#QmTxP)YGy+iN zjS(C)^xDx!-?Q>`M^^tZ$NQOW=2azOvL`}*BG|vLXpfwHt)M5HDv%1nx930*kMM7r ze|DV}fK9*Z3pe-sp6}J&?=p;u`hYHn3R-z5UUWxxluNf)o&tsIm>j}#QmnH&Zt5Bf6Ini+!NN5+)&Q~H54r9y%}{;#t-Iczq>-3_T3+a z*N$Sw(osw|K8Z&oddiZLAlfV%zTu_lYdE_ePSoC+(Q6DsM`!ethPcmyIRSiHLl*=h zW&E%BzagHN`&j_UL+a{PgGsm?ie})Gzj3tuq2aH86dRLlKA-a@$tMJxnxEpQeOsAx z0P;bUv~2v>WI1gpe2RsIW{Mq*f2*aQv7USsN{qFDsrUKhw7qMdoP?U%X!~#|_TQba z^;kugUKcvi*w$d?zqeYxzJKGevC$@fe2{H-xf++Cn3G6dTeFUQ0i?6C2Bv2E2M#lBk z)hz5M*jf}ZG$=R0 z-jScU^~?XoQ|*yClY5X0v37SI-jsW$%Lje$${w*RiF}2PGyY1NMe!%{W`L2dyIa57 zUjrw)H=g)9-EjJs0ZNDVV&wZ2wbGX%ZA@()a7!$uYTniS-+qhNsdONvHnawPxE6iJ zvFwt$k@~%o(aWSXj8)Iic@&LZ(a{~hlj!w~y1H=GrAvc$qtu6*UzQSWV86HV_3_D5 z0Z98CTwJ1feNAo#LULYbqzKq$TF6-bP@6s7G|NPKU(+U;-Dk46T06aW=iw=lk&te! zpd?RAPal+?P7%QXKqR2YvUmL43DyfZuCBW28BUymAxAp(4(q!t`uf84t&;ENmL-n% zHV0P4^ga6aA_bN}W^5M;SK4$L(hA86h&dY~Q6y$tTYpz+zX}b+tparDB!7Q@4zQ3` z2A2Cx`9KkWE9A5V@^hOEp7fkg3=XmRS}Os{o&WJxzQX6K=Jj*)JYV0ZmW>K__{W{V zrg5#bzfoUo2kUval&n1j;-Y*jd2>oKGL;#%s}Z zWX3VRo|fONGbuH(;p6h!f-8DF@0_)fN_kR_{R`?!5G;IYB?sqEblA?hTTx82tmMtt zu}-!Qj;oLY;6BN=Us5Df!`rG0$V6u-S$*FvY;2LzK`o`I%%METYB;-VuudjHTkdXM z9n={n)1egH{a#ma`HLK{uR_PpR+owD^nO^er*DZ$z)HlqOML+fo`R!mYf$w?uNItu zjn4L$*!R89@fVPIopBbpp8 zbc0G+Zsq#7_stoYVMu_2!5B=3zyk4>6KOmrAAGA2Um;eo@TCG2Cckr&Soc*Eg@mMW{FT@*(O?x<0bX!x8V^9FWi$Al4%GjUjW5wH z?UR2ftxM$p3^7sQ6$Gp^?q($TnW^qVsM&q#ZXFhxiL zMMJXZ(QaIo;fzqSQSsZWddkrtbyG_#cwNO1;WBNaQV4k|+SV*)X~bbACi`LTvV~kf za)46xD(Cd78=bV7g^{sueMy4ij`y>sk|SQ%%!$*2>?+ze`!vIP|BF$34m66+W}JgT zQB+^e6C*8Kbz~*%%LZX)xa@1sOwYrgo<6Q1R16rnYrPEo>lYds*)=?TRJOdxA^yM$ zqN9faD#7Ci;?2)jf!RnNz#<0I1foGIEDyNh>tNKQSl!vV?kI105I$}7Lnt8UHMe&I z;<><}pdtjh{|3?1eV*Z7J7SIn-F$0YjcD6M(Qz%qm`9`Osx>-E*uJ%(E2$2p`=aN0 z#A3bg<8y<3K!CHoS*8;|Bw5C%k6|D;9*e_}g`tjYx3z7g`ES^^^l`OXh^5!%{`qTL zofo*H_y=w|u|zCuItwl8gOs1r)|RtUuV3Ik{P?nzoT2}lUHhU|)b7l?^h4+~-Rt7z zMN?r5e^#>8-nsNbp&NV~a!2%yz%+S4YDj(h-L158%9g z3JITk96(?7wgMbLY6a#-G+OQnylfRFbPVRaJk3cx_rfY}5tn^Q)K_2?6gQBF@vF5B z3!Xp$nCIz_QWV#iSa>_4lx1dy0XdAWHide#qKZ&P{TG7V&H*UK$7)pcMeqCWy(PM? zQ}^Ik82`fhCOxc^8@_zhw@+CUPhx#&`;3zsYLlX5+0MqVG5?ifd|B`uY5L@qjZgWs z0UFz)x6)(9b{O^uV<<*}@}tA${tcq@2@tgkee=0xhJZm~QowS;JT*Rk+!cr~Y(R|_ zMOp#$h<5^ZfNNBKtOB14N-hKlFoN{)Y6Z;w9YKlv^O&JHmXbWY!<3P`1jns<#q>0OYs0%^a`AZWp+ngfi+d&7Ilmg3-}F z2mgX3l6`&VFS#GJHzT4T&&+fn};jN~tE|IIc zNugm@@L}wIO($Y)8d3D=9w7+9eRn%A!F!LK%-hwBo%Hx+hJNbDZu4`#b_XuIQr*4L=w4^ORSQMCP*I5_E znGl6Tje%(h1k_|zVgc>|!;xvc ze%}h-SSL6f(Ma5g%2Zh)akKt={q48+Hk=~JAO+M}aBjr!9~^MTrR0lcsKZO2FqJEf zuDW?NI2tZ5EkZ+iO$mdtk7ue(F(BZe5z+efc^BtRB1_^K$c=8P2FfRmCHHMgAp9(g z$OSjQ47l|VaN#W&|gde2=|qBm2Xi(BO*T3y<T8)x$%5Ti_|Jp40vYe=O2%X_SB44HE)jf zUQ_XeC_pTV;v$#P-|K$R9p7SKLeK=+?v*o$U(QHA{5E#!iW9fLNbf|a=O&6qW?k7M zGh)R$S)y0?1fRg6r#&l^#Uu?}AKn7U9}hYLv7JKU8|st=P+?Jnc>!QpD(=6F2LcWNO3 zxn?0wGjw>M%P!LcLWg^Z00-KOA1kmmJlzz;7bdS%G4s<)#5imZnfsa0yK+{6kOM9F6IDuIQL$D~Ss z`C5tzKxTDiF2ZoxUO+sBBNg*F7bhoA%LL2je2^k(x&eOgUL+}(KiGf$@AorGN)8}Z z)>ayUYsI4_V*SlZH;nrGQQEjCUId*kkD(P1kPMscXX^V&=juAL0L=0aTR>!-nDNO@ z#YCbdZZ)^_)rJX4DK2SvOIfSTB4?H~NQT%wC3bBui(s1T;Go_==o z&p~*~`QKryP1Cn%Ssd+cui?g{8y|`CqwTXB9|#Q{9XtdWkZw@$@Kg`+*RuH`!BNmT z^gSabD$HVOj8{I?iNcCiJl?krem}nTz^>vyg6cKrEgL=~jGRP4iVBzkyv%lX|1uVsGPEJlb z_<^6BIcNw)X=q^K(x}Yda3&ykD`xQ*==|NM_onS$Dy_^7*6Za* z{3p#UNLHHg{X5hfAtZ1%T zyMegq&Hm}w6y$|w=$T~imFH0}LW57LhU)wFc*bacKAX9OEnnPI0(OJn6rd@Fe2loe zxjA^r#if-71fEqOnYLJPTRT5L|HBKY+%5(U1eb^ishiZx+uO<7#yZ5sdU*?tU(r;s zGFqyLA_R9f*9ii?fz6MvbF!Rkn@m~N|2Q~WC-WJ1qO$2WR1CH#c58l(3*W0vy-jVc z9e>Yz!2SQZ02Juo-Dx)NVi4?inRry*$te#H{=$GfjZD9uu1~uL6*2<+OQxfuqRy-) z3LQ3q8Ns60lX$`q=otU+^1wVz?E$^N|96y@lHy$QsqhZ*?4E3hlJy&{G_g1-Ea3%5 z@@|)6VDK)I;e2NXpJ?7U>Z*nOBvPqLpV7+%iP8}&vY5Yz1x-z^oM z=lQ=c2O`cxNDvTR@B@ohBE>p(0UQD3z~BH6AQ3@eyg!`wRcE&ZG9c<0Zbg;R?v7?b%vJcA|-yhDu*!hwS|%Io4zMyG@>ZTzZnxu5{u8&x-H zQt1o*DL(5NTu6oSyU6#?G zvQm>0ENZ`N-lcyOca2?n3FSJ;Y& zaOYxOS53KX-haG?z~bix^UsZmdxvdCs}i?UYySeDG+bihCv59$amL@7%8wA3z|R|! z7bzAbu@u8GD9?gr9)xHSsPf=(%6M$}5_#0v*uFs|Jv@XbgJT|5UcW|$7y_xh1sFXR z4DIX;-1a7zqrqm&9ry*H1B0g=aMvD)+lD=|pKKGrRvQAdnl4}FEj6CYlKR-ls3{a{ z)NPNAE%_TW2zNGy)g3vsi-J7=l~Et+RQBsccspw9VduZo;11IA@)80%FsrLbRB3(bm>0FDOS#pYO?%wqrTPd5LTfF}r%{#D1ZuC$%mM!Ntdi*3#w@0?P&#&_`i+ zCj(6dy=)qArr_e_EYB=2w+9D)mjGGo$J>Eq1S9ccG){o>~X!hpw;_F+d) zmQ)A?Qu|k+p^SM$!~S{Z>IsHqRIpKO%gygNl$ku9)((@2nyQ79f$NpekYsUh;mME~ zRjA9WCxM+1Xid2QH6j{Bkb9*8J>*ql5Qr3DPJ}~@;c%?+x^aZS3JSKpsU=$Sf;|#5 zM1&@N>1Kq#&{iPz{Oo{ni(?Pmat4I%|J+pY5G%{rCf&x)b0*Mgyq!dEbUmDDR@13} zRqxYsgA4)Wg%JRvI<}nESWRO?aH*&q4i+2hSy@P0;MQD6O+KGqF~fU3ve>>aMc*JK zbO9Ca>!FW~9CJcK0wU!2^i%<~CYkTR(UJ`o&>_~q+n_fPjo>BNVzS`V=6*)Tg&d!q zb>zy&Lm;4)^Y-289X(UCn)qyEVc=_Bt&mPTMnF2AxPCPNdvK#3u+x;mGjSwGM*VnGURKDu_uWlBKT zUIo|FrA8<{2n!+SibCRsxd`+Q#;2VB=0RG)$1LOzOyCA)Q`A${+Ca|G2AZ75?1BQb zXA~3*X-;LrAOQH610rqiIk;?U_|TRX35X#$V6U2jG4(7hO(yIm&FYu;nmjvk7w||& z!`9EmcZCW1_t!lLB5fc5i)+1tvVv zq#xHJ$pzGV6OFe2q@h4&8Z6GloOs5i+P7W(FhUAR0`D)b((qx=|Nad7C0bRjKa7_4 zaup2%?1ojnQJI5YN07o97#Ki+(7zSi+Z!YS{rp)5D&LpYbk@8NBxyuV9fFf?nxSXbmN#qmStF}WK z#`TrCAlI=M`YJtuM}$-`_skUaW(zMAuKWzviJ(}?^oU5(uZIGBV^qMwl&7hvhzV(3 zTofB09d*b8W?_k7=5)CNKiO9=X>%13aUn5S1^@^mh8T`~f3?dv+-Xqf>WE&!%U4Hz zBw%ieke3~jh%L<%;egci4E{~KAO{74egOgt#9^QY`Prwu53qT{zaqv7vcjSGJywpqL7%X=OB86=hGl$TX$f2*>?|&Y{5mv#YZ5f zes7r6QckTG(Bn4u~y{!wOiQ^*1BPYL`RR6AP;f+^y{G@Pu@;(I&-(mO|q?MC~ zWBKR$`DTUYg-mKxBr77uk4w$CPQ1*7V%2Vrm)zV{Rqr%a5K)6*D!*TR;)1<_RFdKn zN$JbOdCX}KO3IS6c!Xb}tFd+IkJ}@yD>rgz~%`!fjsN$>qI=<+`*WnFAb4lFhE{50+=5-?t0A> zY;by~fwl4(PW?3qWSk5O4VAntPO=m#=TY-*ame@*{$&FN`@{kn`7Vi5Km3bKSB%^X z6;)OLuXX%9e0<*IFX_xH6D$3)f2ygKSs5mm7v`SY_9yh=J2{;Rd=vM9LgCXhGAxvD z$nXDoiRjA7&A6$}DiXxk!zuJnU_iy!bUi!|WSJ%H83ohS!;7a|Kdqc5Cl>&+LCqx! zt?3|8Ul^L3qe4(IFsz(`j}d}^-IAAtacAi0dQY?g5OK>mK~ak!4@x+4Dd;rcetBH5 zSligNjCQXo^!4@q0PaZZNJvPyVbUrZ8X-kR%wXL?A5ke_aMuiAu59IR;x#1y5P)Vt zCXL^wRj7P_wz#Keal6cI`wDA)M=XIh$>UWoBb;<3T)emYh3s~6QJG5*f!W&Cdm~il z#@CV0g240?;4}mZ!ju?2y=mgFU$>>8rMv_N*`6`!=}!)ds#&O65cuzeIBmDS4{Tlw zznn2ZA7mIo1Yx?aUT$$Yc=nW=8&dxM`g+^s3nzCscRN(dx77Q{C+$s-Kw6fCnPek3 zO*SrcHQ>$k1 z?DvmVD4~!aks4uVYj&ZnpY#Wi8vhHy@`Q)AgYQIFS{f13IyT1L29~mTB#FYay8jdUXH)jwC=zv}TcVT8=el7z{;L*Slz8nMg3`juw zc>_pFN*TAuj|~liEL60FlBhS^U~3K!A>}ge>cOET6`Y`ATNP$#}7Q(O-T?1DV~l13WLDgM1hu z#6JjVH>C{?X#lYT;2_$Vzz_5eOlk+<^+g7s-iH|C%g)XYX$4=jGkCW6c>sWZ2$DE@ zm|0oBJ#f|uh>KGJne)GWD|L1Cm2_5MxL5-e{z*3gBE!HyM~`4*E72w}W;fF^efj9k%@&Pyd=4B3JQNz=vs*PjDfaFOLYWbjm{t`%cvBl}cUqK> zV@uv)fmtep$G_!Z_Y`pYW~j%<`4m(wEaz-2Z2L_f7YuEwk@I9pp*??h$hP@DSG>n3 zBBC0foD`P$G&n;7$iR%GA7#GTo`KBX(Oh|gxk|a8?>^aeyisTYGe$dj7a$|Wpwa*o zOxt1kyAOS!4P=53!W9(bsLX%PLQjVJH)`l|vYLV-V@^3)FjifZF*p57WMmK^WIz(<7JUo1>&@?5tee2-Af+0*LJE71HPX8~~#`)$5tR%%cFxSXv4 zoeG@cXtoS^(-9}bVjLBxG`G@=Jv==_jzERb)z{A~{Qg~1=>#GSSkk-jwFmpk$#{xcmOf{gL^LQ*C|I2pR*CTImpIV`uQ_2L69 zhj?7Ps85g=Y&%Uyn{cx9{n_iJp$ra8u#pt|xL>(%1Wu(dN*ThVQLp=TAz8GV8zJbZ zs4-NYWCIcD+@|5DC+m)a6^@XIQoAA9qjCC(qWk$y)sd~hrCd4%V&+i$QRQ90^J zt9u9sqxQRNn%wj>9c|N3-a!a2$At@7cmquhj*3QL}FnI)4#g>xA+9D*&t%h_NGWL>5(Mm zsmA^vQ*Rv>)zCOX6iGYBFqDX^)Gz=giE!_;= z-Thmf=X~Gm^)KbpanIgsuXW$|rzQ_}<2!b32LC}f*zYU)bPVOu$lr0Y) zX)(z95xBUxOzbItl7od@B5Z7I_#ZrI{=K`)?qbPMG2ROcxV;Ua0ci&!NdC8*x`k)Q3i9!(0QY<)_A7}bebyQ{6|BAvf(!Ia02&9 z?qh|L4prcCM+|yYdWe6lEC1#!#6`t{o5sfE@+nbN9sy{vI|+MX&nFmwS3I(A>ze3s%Gn(CDnsGvF@4cAZ{ECl zW^C-=1?E{&%Y7L!VAy&!+n!`N74La{S>5#Wb=P-#8RxpIC6y%d!-^2S?W3qyqLR3F z_hrI}vUWFMnL_mPviLl#Hx%UPo|q`=9pti)4i1+UnxzghXc_>AQpf~GHSaviF-ZcX=fOCYGkYioiKOl+Gh#bW|K-ld+YLtnJ^ zjdi{&Lq;9zOdEk~>P8@BWNZD#tE0IcFbHqYiHBgI^Utl5kN8SteEeZxvGJ(|=rTct zR{Q3;|Cs#tH0h5wIM#XB0%6lE^H5(X#+FzA+m@%E`aEJX7en2Mr9*4Eb9?yFO;gFZEEvwf`UAxK?8 zbZFpk4&HWQW&$Nlv9#Hfr{=)D0v3_s{YYC!V>Z2>QlkY!oz>MrX6Ln)# zd`4@~I`w9Bcdi8#bMm)<0TR?1*4V6Ma>}hP2g}bPxeOWKbedFc+(H%-$CqOQF{Xn) zc<|Q}J`n-qG6oxM0@_`jW~K{l&%e65xy?cYp^Z3jawSboGQd~CfT)D5)#ktqymA=y z$EILr-RV7Jl!Ewl>8~qyG+4+;Ie0X+o#FROna)(8?6k1LyU~^!kfwqq4UO zjWrUv64-4|$;`u*t6bbN<7tx9O0p}1Z%UhtW;%>g3v?8p!1_ngHpX$rMDrr})>F9? z_&hdCJpM#d(du6ab|vwhET-WDhl6*SnM@N;a4|_h3d<_!#e0EW7qg0jnVF{!GmLIX1-U>pf-w>UwC z*J5vPFAX{?mt9Xs9P|KC$Kckwu6@CQ1g&~Qa&p+kR)T;VmA9VWuo#H|>zi1;Ii4+J zbj8RMi2(+vt<%`CeU^xsRa$0W-iCyFg7i``LXl*=UT&+kW#dIla8MHPYQAUM zv#v#G;qu@fGqbf4>kaN)WrK~CRXfyi{NfJ~urTLZEP9LiU5cd$*#rS2!}&jhLv)g~ zsa-o|4-TXJR14TC@Wp6^%uw$rxbEMbQy}O*TF`qEuKPJJ5r2B3G6pY|A5IUksiqTv zSlc{uIJquBKtNc~9YA~s8A47#W$FNuLfdR@ZFT&Q)<2Ge(psHVF*!Q=#cO~ToPc`w zB8E{m8lRH1kp0=aF^XE}`eHV3_1AhaW=%usqz<;Q?_V(3P8WsL|EiMzr0FP{{)3C; z%7qaYA|=P4V#JbhY)ZNHt-jg63N);By_x zJS!@5C*Yx(1<5~60^hZHe4HAn7CrWbgxg2jmYuIRTy1dTaKvfE)NwfP&b5H&DUK{C zyiZY6;m9a#I{(}CwrjqyBR2!h4-q_|T*m@bj$**PaUJ-Nt8xPj?%TI-uT~Zpe?X|6 z*+whoIF17_?O>0>!qmr^9bliVL!YTet5OS6; z>7)rzvEO~HP5SoiMdD@phepv_uO;W4-GA=#zNf$F;)aq%9T|WZq&y}Ic-795Qc@xT zqr)EuE+Rt6>${0-I*?AnFDDPr)(j=~#3G}BxmF_oR;QOP29EtxR@pxSi}-MK9Ug~MC0#Z&dw&wA7Lk0q`U#j*Odz=?;WPR zR+s)(o?QI?{rjM|w>KH!>WmJMTt^HJQ#q-`Ss!RXh``T5eu&&2o{ zku`?USA61O&rH>{(IUa?6}g-BJHVU1%?Ck6|OyU{I6QvqCsB>-0)C$!i^JJ0Og(Vl8mL!*yv}DG>h1G4Mq)VEK>bBV zrBiywz4bjz*P8GEba zv$EiCx2K*wx+hC;6cGFJo`Ap|08s)nT{JT@ooogfA2E-~5uTt^7hK=%&=a)Byo)8J zRvllvOk|~fz=jWv)qXO6L?vjlV|+}rSaILvcZaU|y|1ni6;N`Aw_(6TE@i=Zqa6rU zoGy-eKKNZ>_evvHm6H;MXUxNitBNF&l?lExWwudAL577Oxc>%;2MD|9xh}J&c^kDo8N-s@yC7%V9ba@IYQR;eeCin#Z7u1gIKK-aUMxUV3`^ zM&uFpujmvr^5Y23HGCcap=Sqb6}mUSI&bklpdg_U;SDpM+~nW?fjpIwJ{1 z*vy$5&t%y{P%V+`1y2Y~Y?)TxKOaP}T~BEm%igE}`eLpupbmI=daD2LO8;m#*^mEZ zg-k}$#5aJCN&mNsuRU5Hjji}YTrsw1P- zpXCgZ_&>x1@Y74OH@U>WdShH}w3%DqZ)lIl&+GOSo|Vae&74H~4xZdY6>m(@5J*hZW){I2YspA_~tm z)NXQE@(NiuLrh#11$FI6o>uh+wS$fyV!F0r21CwVs-ukDP6;DYtR@t^}GgpUd#)F0RgAcn~lggF$$VA+e2{AV-xEbTp;rSMJ+0m1;5S zryTh35P`KtS2-Gawi76QwpMM&u6gPGy~hN_wdU2P2bSU^7zUf8+Pc zF~Y*e^>EpXaNW4*jg9!?*dL7J*aj77#}9d zevBG1=v+Wg0^AumHV8TA(`IvDWvLZU^V5&F6*enDj zS!QXl*Tw2ti^3VQ1a_(IaX!)18#XzjZ)Qbm^p4)p(n<(F-J1BOQo1>6)Zl{)ICm3G z;Jlv%f)!v$%O&LO{L?EwaVr#o(J`t+m|80+ zwFA>WMvxowvh;QjcLE?73<8qNBhz>4Qx9iaqT^rPuPx-#5)()GE{N%rCmLLG zbdU1^t5E@%cK&-WX;^X)w`B+#2p)n5_<)LF0rQLRF zlg6#_kzLTFiT0k+x9RQyfDN_2{wiqlShnb6k0KLV`I#pj9{#x`f~s85#i}Cj`H5=y z+=LD1X$yZ1w8~(u`RG=etgoAW2ILOmAz{u?#6SN878mo;h&nuzB!w?B0t*qQy83$X zSaltHYTj>r;G-*M9Kl>&CLp>)6&mAADj#A}CWXwfYBc>vHKTifZ||;CZ<0V8-jAn? zd^@VM=ih+{78=k`M+@KpmP_eRA9qIn_`wkp7M57vSB(H-h<&YR&$F}qy9k`StsqXUWmSma?B@1v?Yz$}Y9ya*~!_$2w z4!8T4V_!Y)lx#9^43kMj;#xY<@tlo{V#{M?1p=BvyFlk7`_Op{=j zA~CN`kDHag^j?>|_~7w$GMUa);*Ahx$OXMbJRQ}#rh{NzJHg!EnjC%~71aWG&Og)^ zZ@xhCozmlZg}`hJGA9VGtHVqGUf*$YL@ai>ujN%qJ;+S^o>9QAN(p<^_Qk&VGb(zF znPQs$Su9=tl!Yl6)5-h8ZS}}!6O&BH_Uo2L(x)<4pBfJiewM(oZJ6S*ce%*L>h2^z zNdBrLjGV-xkzDyX5j2%lFIhf4Q|~)z*~chb@W#|;iCo5J;1z_)%cDmo*aotDq{p@J zCIoQcvyUt+SfEVfo9h>%{*7fnBKPs{GvE~E-8b9_P8cL%#-bU;!r%TKcQJ2iFaGH0 zo8&LYVsgO20v?CzSskK(=}2Ch-o~G{+$$zTq$kS=Vn1NJJ`bRIOIJZhb$=aZDIC~|#W*^IGWPMoxf|Qt z!*QSMRj|UfdDZE@@i;j5cf@0laloG7fgr5%jaz6U3`=_^#~kL?v)-K@z4Sp(c;d5; zwziRo`A9)mp?-x0paGn10O%S3WzE3Dx&+YC3FyQ~Ahkm9SMPvt{``N_{1OnpRa1LR zXRtr-AeBgnCMt*#9KrTE>4cfF9N7o2$9w#!M?4vg9=W~;FYqE~DWQG5fS)v( zR(Mo;h*cWFRVtW7SU{La<`<&x1w=&!SOC&!7ePyr2nbFsS6aG~WRj)q@W)=XfIitE zH-wlLsM`;)310C9&ZA{kQPJpqG|_M5oq27QF)*5+Hk9kKqU0<;SGv0Tt?$Cy^T}gO zOmhAXP*tyItF0x?7VnYqrEe>?z zUWdIK1)F1{uU_q6@ELQ>{Bq0JU*6~*0a2CRJ)NB*qr-zXABYl19`575K zsiO?Q$6&QG!HS6b<|v;fg)YX#Sq*PcM8m=8FUW?WOZz5MQ9r=6Ejt|j#MPdsQ=Diz zh+H-u+35Zn4sro~Amf!b4&?V{-0AqGW0b|@2$Q9ZE z%_R3RC`;k9w~;r*HvspZ2*)H+k%2&P@yX1G*jNProDVY}F9q&!0{N1sdZ1ic&P3V2p4| za@!`2qTsk%uH|H!ix_I!T8R;gA0zXUKOKzNPeg2h&ylikdj=stoqB*ECOjxMB?V7I zLu33S_BlGKyk8{9Rx|~HQMz|%^{sBQ7XE%B?z=ZaYoK5#afnAI!xf?$ZdNS`If(|o zXFne9?ed*Waq&wHGy4|?eNIRtblNfsJcIDslBpQO*{&ZJ&-nUzgE=@a{dA`fFdUno z^}Bdp3{Z;^pocyNpq|I!>E1R#Btmb!XCDX)FM(M`cSpyM4%=OlC;Oih>J}wA85wQ~ znh}waXb^CT_zGUK4C$o%p!(_P6LOdmL-dmCm%kZ2?>#zj!xBd?dTSzdn1>clA}|)> zfJ$PhGo@amF1sM6LJ%VNK)#jFZC*UKzc8D*`y( zP+PLyD+NdnL{NSNi9qK6DBjN8fc?0{*3YuC7=YJIpC6t$PE`eh#`S7#!9OOL0v_TM zvnv1^+QZfHF3z3l+Ov_5E&`?8Vv#nhTA^$(Az`F^Z6LA!2c*N(Do0&i>&|i;_1ui( z5git=-33KOby=-A^?DWpB5=8s>uT)4pAYQ#VO|%P`{zf%w4%7oLtXt23n`JOr#KkB zBLO^pD#FfwJyT!12Sz`wV2i>7>z?f2+BY@=P9dN0>$7kTF17dF!_^F$= zhK4Q2g%`j>wgB@BAIiXtbqpm297Z0{Muvh>G)=K?y_5Cwf}$c3nvOcU0;qf<*9Wt7 z?KhDUY%t0AofD6w$yKx!sT6_ZhA%_&V0~N9Hb_Ir)>ceFE7_VZHkLIszdKku>d0b? zyYvx*G)~#*ZEZLD><=2d`IF{=aSqj_ynhs)?Oa@)+W z`LZ+P<4?BjdsE%Oe(N;@+WEDNuo$2MYnq+S051~x$HGD$v6TrBVyO*8nwZ&2w2A5I z4y2TnR{u5|4*`vUJc{Hco9o61A=o#5&#x{G&sbU=+8U4}Tr#tC7R$19sn)Rk_D=}j zN}rANcW`P%qgPQ-QicOZkc7!mMiP=+vU9oPECb-u+!7~MWeR(a)DyO(D!RJ61$eSM?+yw?LH=^ujP7*MhO{oKqd zaOihHHK(q-l1b~hi!i|S{T`yRDYkAO1;?N&0XL~ zRIOgfx@y*^K3zf;>5Kx?EHwxRGo#*WOq2`nIXSX~w7(yZh=(^+@>-ZnO*3 zDkn#aFdue51=PDNBlP+=0FL19iV`qygP_|l)!!eRDFG;@FW#rrpAW@JTN=F>j~va3 zTAF8%5XhBWA<_;=gNtVMnD~1W&!krGw{1JXtgKp)$V}jNa{Y#$n)*pA zb4bD)R`(tC8t)sYjmgp8q0Ma^T`gE}ax?bX2P|g+)F5fyccVKD(tbiiK%}=0l>mh6 z!9~sYXP<(QNV)9nDS@5g{L!7e_r4d_dkZ$%`DOT=g&?9$i%?h}v$Ga#rRioj>i5?c ze5fC%j9~o22xwO&!_Uvl;R54mqM}*kcP7Byp@p7h$k5;Bu-smB8Q2Zt(J?l%v$Fo~ z+O`uxzyj>&t4fE@J`T$Vx9Sju^ z#5HC@8PMpfW~e_}!UwpLEiGTW>(jwKhe1FOQ3@=`L+z)hitT1gyCnLT3gricdeJ6> zHr@aLVD0SlLCns3M*99nf_w6TLXfx)di1*$A1jiiK2JYGr}KBO^Z`*v713L2+JXfk zLDh7-9UFltD9SXKdO)7i^glo3+-=?E{X%_Kc$X{P^t@b_nBk||u5q2H%$D1o1dO;BZ;?y6q}#*Ux~7BQ zdwS^UXefG<1zIp6Fc}a4{B}TWN}vQPyDgBcY{8A~x5fV(@Th?10eu57eFmMELt=31Gp)=_;G29Hed{;Z1pebZ1zS0SRwAb^(K%a{VSjBAs zr|#aOrz0wyEie3~`oXU053XF49tsdDPCOD4<*sc=?%+Z6!X?RYl(&+L>3V$^p38Et zT4_NN^{zM%lnBcuQ%`tQZa9t;9UwgJF&W-(%mLO`0(w?Duz z9D*qMjPvvE-#_m9Hbe^0#sG}=YdOuf|LJN->;M}F2M#DL zL>>q|U`RQbr;thwQg~L+xL7P20EZnOBK3x0MzX58jiv{V=MX=jHNLE!2I>+8IXMWp zHI_1oS(rWho2v93yDhT67`G~AfW4l99~XA3jENxI1PQEXrr60 zGDVL9Qv*P)0!2?}9`I(F-~$?Bxc83#MwOa@!8@QI@S2&KS=JPnSGIAUYsQ3-%RKt| zD~;ZR#fdP~OGbj$p^Jyt61}hph}a5|et{uT^AQ_R2d69mBmbMTH?Uho?d-$=$cUFp z#<`nhX_3l)Ok_@i1g(3z(d!jg2S}^2bL-K_#S^yIVSO%!F(+m>A!)IpxUr#~(lL!fnzf zz{Fm$1AH?cOtdB^R@T-L07I_;=NLIPHIm!gN(vNtDgd-?=u~Or0Ec=6=yLSIK05(w z+htuny~jGaFPHYgo3IGUv5@Wo3Zj5kG|9_}!?kJsi>cO)w>3{gSFPC%kJ2a@So|qh zpbrrJRulVHwADmS*xR%Nmv^Nn-(J%KKj2`%5`bGTDj!^w=7Met;<`HMe-1^R6Y{NBXELUUm5Qr*d^6bD*K zb7@Ofrg#Ph1E6r^<>zm`*FM0(>fE;5qB=3EvYe&dS(2yXy0R*yzx3+xa;4EPXG(mc^=YlEHVE44;1o^~3Zo<0akm|~48+{N-g zPATL3z+P!Lm2IN|EtbgLT0+*o}F`z%Kcn+eNcBe>Bc0mBoMRkF9*8Q6YY4{pWt{2m2wa;8H2 zd=GQ&VwP{P>3E>^^UMQOeKbhc?mY?EV8Q=$CinJ)o0a^1 zUPS@H`G_!B+xYdqva)j9zxp`<;%|4rw>vY_?l)O? zrKdOQG>+}iesCt;?C!12J{l=|)rDaf&3@X1eu3IpaIpi$l`}9fYHkk2=M1?0UW@H< z(^pR)X-!|RO?M#*Rc-xacNEbyMW8%dXt}MXK1wk@A&6*kR=uwi=YWH1)q9-KP+h27nl?xHAh_{2;RHQWtD`6U2_kN_rj(y^ar z`PJ1R$&M zDh8Nq@oOJae3q;@Y4F(lvesu1sNV*nr~o zvoHB)8hNrc9txVf=Ky{Dh5*|tAXS6^X#Wbtxl%#9sK0_dj~2DuN-%n^m}ZlxemKIY ztkEw{7%f1g-OXC+zxoon6<)(2FebBlF!3Di1D@F7y6u_52tMf;RzV~$VinaC;dwyG z4*|~lcj)#e#qI#r0b!cUYfwyHjM@W~E zS8V$aMYG!jgAH=yBWNZ;k>ZEz#PICJqb}S)aJKicr-hm;g#QD2z-BPQ{_ifGhyvNv zRzZQC_w(1tHaY^cHwke&N+QI+d-0^CkBErqrCVVr&{xYYoq@iM5CWq1XW>C7o;88M zQ}bI4IE2jklxN#aD&7SG9&bqTtJ-K75_qD3LgscAU4S69hF`h{cEyEQR8#@WU==<6 z#bIi%QSzmZj(~b-_5|#s-;0Whz~`rmIui9(YYn{Dx1V}L$)!&XnG9X*EzK%Zw4qG~ zWJtSU9W3|a0{1+Sl5?{oXc3Ked;jHSJU(A(D;cW4tO$e4JbTKzSWAjN(iRYnMdB`z z4z!`yL()7fVjhc=Q}Tm;&sq9Mvu9#tTLZ73BZagA$HvAe(6PN>P<(v+f0sN9#%mZ* znwVQ+j`Z_~zAgymAEuA}p0#KzVE5}_lZ8yNZMCXwW$cyz%lX=z@J3cQ?0LWT#+Q4M z?j_ssSey7YD>9!Gv2n8az0v-rhn0^nW_)byzx&+?2qhR`J5WhlK0b3a{#pa4Vj1GU zC(9e6y9TTINLCoxddkWDk|bO9Jt{TP?Nelj3x zJ(ZYNWV4p;&i^hP141lz+_7&%Wik^dZv=r`%{Wm~(U0Bt)ITiS_74;Qqz>1+D@LVe zp&F*@rD3*)avGQfY4XPzal_vlFq2CuGP5)JvobT)aG+10KK-}4cM1)v;|;4*ehXoZzdD?cZ-`~BIV|{I9TB@O_O$zmsDgh zYG<8@Z7)pYcjP`3_1Ugz#=>gh_dg3V0G7WVJ$o3C7v(p55>c2Vd zZlHCv(7rdiV)V<-Kn!wPL9<$Jj?1UZU3%8_SyoW#yeG^%yV@mG@NVVzWWf^(_U*tg zU(lGDyr=en!-3r2XN3s=^q6*@x-{?J>I|3dr30A^C$6U9za$^g8f2R#>E{Nl#ia3G z_7EFy3!}e%opq^L@;+!`7AU(j{V%wFd46UJCj{A#ogmCHb^gEuK5uG+DrxNVyKk`Mn;M@`ZWIJCU4M(~l{pJvKo^f*MTKrw zi)OR}gQf`_iK|J^pHDiLaNcT@cx_1lExX5dDhNG&Mjg_v{ynFZ}#D;QDc)`Yi`70(^@v9FRdRLs+oP;ngbt|8W7Lr5LDn!i|@Eacq^vU=Qu# z`(Yy=*PSYK@2O=HCTtRx`pc{7RDJmN=%JoMoS&NKeX=#&ze;fU)*MB+mDkt#;)j2- z2o@0`r-rcvx*&$@3*=D|y2=!BPRT>JpRqZ)K`rNcY+{9Ox>CGnB|jv)PT;oOP5m^9 z*Y{=?$aJzm9i!^=Jf%r9NAn@RcM@H(wz$-R)3s=qWs5kAU;{oE`QvR_CxhR=*&qZc zv!5n#>=lpXw*Bw9e8G&R6@Bt9iY?|YpTAvD$B#3Mw*!5bXIa<*gklMpw77R@ndZZ^ zYpZ43mbD^OrPj#)!!Y zB@SqL*scg4CEK(wcTcllkWD{ImO2*Oxb~~Il4fV9B$k)5_PmJM5iFzC4waAKhQl$6 zF6y;`UH56_oB}4vBXzPz>VTGqj!dRg(R)Km^tR3`_-m^N*uy> zWnP4K`d0KQiR^Xb4iEt4UqL|5(c&h`@A$KDta^Mw2KF3 z{)Atjj7EB+WgGqZ0e1@w$w#=+C;x0Tc`sm$9NXJUnIP!5(i=?)+p0?Z zc{BKq0ml@snW|j(bh~?aT);={gbbpY=Sc1!%Z6+%HtSomF2L@7k+9erYUKN^E)>ALJ&{WAaQffja%krRL2MEk1KQ| z9h147^F{`j3XK_n7-?AJ3cEFP04ep=SI1kE`eYnxnGO~f*&qH|Cwu}T#HaBbIz@C~ zc1`cRe8d&oB}13LS#-6`QAD4^{lZ_m=*34SN2h*$tM2|~OutlQ4?1(D+!T4o9QyY2 zEC#pS=L~c5P!L*7FL8qxGZEQSZEO*(lV;D=T<+CYNK4#{?L6(Q0GI4l9 z?YKMZLwOm>ttxt1KRS>ua8oWpE(g{t*&`T&QYmJA=^4^%2&4TEDTTsVD zjVUZwXYSZ5q7gq%f3DMuV+w<-IPhmBs`o9%Y)Uv%HtHMuLuW9RR%&Qy- zUj>ISU`n{+RjE`klS7L3nSTOqhavWU9dYGK^WS2)4DVNGecYMP=+(36E6oV+;*omr z5D{Ei@A>`!u(ymxY&p!AM7b&;@$o})O4C*D(yt~3wYm!&;mOaUu z)1RqY%9H*BaHmZ{hrNY{j;;?Vg;m=(*C(<$hlhtsN+MDRQue?`>rSrC+M*L0_mzuS zW2<1gD8uKbar|EQ@WI9)xS@B$SM0yOBhmTBy?p z>-7zBkRO^x$}eX_0gi37i@cVtdwMR9L^^5Y0Bu?ex_$4-mKtxf3wU{nRO&?p|Edr( z4d7^>Wg%|bZ)CP17KXs8+E{1mXg{JkMuoq9OgVfWt^*7M82_xGI{Of>1+ud*Pe_>m zw)w{r{cXSgeuPAOmW$XD?Koo~TO$xqLajG7^5&tFsiByv}MLq5D%M&eB~r5|X1C!+3$bjB#L!PAzb zS*GiKW2-eU({?InT?MZ<4>&CgF&BZsnLU7u#sNrJ?*>k&)r9!?{i?a4PfZJ-PR;=c zLiKX+&k{}|U)izkXMM?;C#HHGy;9edSPF~s$`Y7tf>nMv;!((+HN?RW3YiB<(g(t1 zZ}2enn)hsC(-YMtyu@U2nq#DO(>Eo-ab5vA13!_&^BWQGR6M5Jlln_+LV_Z2ACbuF zIk_2FD_~j^N;`v@H8Z9cX|E!wh@a?GY%8JhKW;f1pJ-{uoXS&ZI7eN}h$X=o{X32r z=(f=JaBsF6Xh)1t$&~S`3UzZkqu;Q%9fEBSvIeL)4mlMWVP$K@FqZ4&;|?GH5l^OY z(JFro&-|dZ)8N-%Pg?4`V#~P1$U-DdV=GfABAG4ar)=!S1rhGD+2x^WOLNOug|)id z>n7xcaqaNXBrjr86@29vFIaMHn;HO-4xdKEPM1kWCS570?d!HI`!_|I7VCY$F5yot zEgi7b@Z(f$D^+pCUrGuZ6dP#*0HdoG6GcK092q&l(b_!MT<8XS34sX>c|b z;t-2l#UATd_tEV50n?bp$;D9cH-`E7`Sh`^=Ta>wn*ZKkIN*@Fv}tKf=kp)gT6R>q z(`|=cT~T4~b=%7SYYz!jvx#&FT3{r2F}oPYr}$VI?odOvk(&J zBT+;l+M^ozAqE`jv(xctXVI{E;~;P066X#v{!+azrI(4^D1mVJG7DKD?u%Bq)UyrC z*TiX(&=V|sae9(!V_VEWhIgGk0(kkV5<+YJd+}_dBe1x}hq3slm&B0-L0@jrUATU421eawvdf`h zDsTyY79OvWwP-%VDtK-Ft?T7eHf2?x2FHhTDSuBhly>u>e@i4hulnojk1CwTP4r~` zcd<6Rytb1xz?3&3qi2{fg#^w|GOB-c=xo_jB z?fBQhywCoDf7X9pi{;Oo1E*-r{T*y(r}d3O&f_2SM))!c>YSq_O-=?HexM za(HLxoJG~w{_(2LAChs|+1a}taUNzQd%L?N@)4fkP{@*xXdkidu`GjwxH9tI^m>C? z>!+3e$8q<@oo3bGOiyd>ib(ry8PkaZpV5$rF2gaCD;Zt$xDwTs~M-bnK#b2H-nQ8P z>U}SMl{J}o*s*liFaXaf;6^6M$Iriu`tWNM$cu@r`g#fy9iCN+9-ukvSY}pq6@H8E z_Loe=w8byfTHk)L1&6gi?l%b)u|N1G7t#15)XGI_N*aT0p=HB8AD4nNru&#J{bKJy z3X(URUgC2!I7SdTu-2acQ{h zU9uM>MfflY=j4Sgx#LTw>x5&MnXp*)Mhdl`Gj%;hVvCM2ZMF!)FpP31io`?`m&2z0 zzMmNqsC8zXtGiPh3cb!IFR;5a`?915n3;Ian{2zSgInqADl+5UeD@xbc+;g_Wg@JY z=)OeT?kGvoXdf$d<8n-3?~4XSyw^L)*U6+vj>n?V9$D;58Z81wj<%o`pI!%Hg1i7) zx;c&FYrx@tnT;bK(P*3DWeJ?PNt*|P##jnTKi5ByFSMTtcf7y4535@ADye159HRT- zPvGn+OGma4+++uR#>7#vw-i-CBU{54i6&mb4}YxY&YiFUJEs)2dTSP+=w4TkuL1C> zn{wV^wEw-7U?L10=2X7o#t#~Q_)HPNN#Vd7F6Gwb4T&WN=10M02>KPG<59y5Q~C0z zjtJkS;E~XdLWCP$RfS+HH zFR@p?+X@!eGgX>b6zMK?CAH7UV1r`)B~0Rcs7kfBdBAel9RZzl>^jRD(vt^d2F zIciz*6U5BeiHVQn2L_Ccpugx&;U@ZX;Thf&wxrR`4JSUpOL_P?Kg(ko-4S`>N(zN@`$Ea*BW}1zAKD<9pv=bH z*SK=oEo*!gN^B}jdmNir&{STaEiV6~md}P0$wXaJB&ByZ?NGg?*n$S%(u1Uj8U18q z7OTSjMqVkL@TN1a5{42dEqp|TPQPuSSUys4$-cUC-&gvuzpI_2eYi;y-FQhP!xwZF$ z{rLiSKslnSe)-RZ*}IV-`OsPKi=1^%6v?=210IuC(y_-x=?KiJy}W&}_kDMfch*Wq-KNWBon=_7 zplDn#?~5-J-aCZo-GG#e939p9uhYM-mruw1`%USNC*S-LRY*F0(^5vAc3t+>P37cp zZBRY?q5~EtP1AItUQ!|Do>BUv6cH>IPS&eLq15<{qt_tB^{mUqpHk*$=hCvXbDvEo zOSakjj_}8+Z%9@t3cK`#RH*?eAwhOxN_)rxf0Gc9;J$ zH*-|W^nRV}Ea!y*x(auGz4)fx&4Fm}e^oeyT6?87Az5?BiFnVTh=iN3JV_deMZ8PhH+-*Hwb&h_ z`spR#eKg>RyB-^rZ+@9L7?i9iJhGPiP#w8`Px%A2%qc3^5ZH)xCDzjC6;u2>jQU~R zCpt?X%y%@Q>Rz z)Yti?ggNj|U(yP}Fr@sbU zmL?IRFkpho>PIJe9BK#RD!)LNvo}Y2R?QE*mP{j_YnGWxzp&hBpHu0$JK8ip{@MbF za#`eny~}@}%X$$qi&yKkZMGV@E5`r(E7lsTAyO9|k8LT>}$^24Z!Yj9x5 z1CnEs<{^)Zxgmmx*^JS(?a7~!&bem6GZ zOGOaJD|u#wFkSUJzozF&{WO4XXIVpHff!NkzcXa>E(wVoFnM(3(Jy`TYi8tACJBp| z+iTrF+hl0%^6+sBmv6D*-a=BV3`fjDz+V>FfbsC?7b%V%Zv6_GQ7>eA)uOb_0-NPk zT12?c4Mx)|ZO+tp5uiW>%YReg@f=XmLFMPG3hE`w;zUM6SYPs;n4bRn`%qCVq&1+T zaG~@mIro(B-`ZI5h#IY~7`CwKvIv86%I(+hFx6LTC`e+$m~^lo4qEoO-_#)HwgGpf zvnN&5YQ-k=cFG*Nk38y+ja|r5NHmPZ&>($77ZJ~sjd4igibgv;|>Ci7l8CLDa6`vngUpzR;1&Rp>q&hg-z0Z@;d0bSvG&YQF zSUU6F{2m6?^N!xKJIB19Yry<{0}xkn`R&F^>}J3Jci%2sS2BDlw&q@~D(ecR)fLp3 za^Acr(SydFuuQiSVhn3fx_N+`k}j}kRGBXB=ui$JiOcXGDJ4%l*752cb-ETo3-qDY zd${dhk2Wp~IWZ~r19Q)DpjxiQC+A`TOp619U-|znGh%94KPgZzG*md=!2E4equ#UM zJ}BDkmfo_=G8f{#e06awhVHuKpTLnU9Hb%+R=Xrc4Ss*7>n|znK0gXW2%h&4!(TOH zyZpLmd5zm6`=;6)*xc6xaMhAQ#EuG>7T>-!Ms7fM>$!O#e-WYr$B_8EU26QA(f_iP zOYV`n5iT&$N6U2bZPb;dEbh`*g<)y&b~YBTn&H;=G8aF7IR0}fI+{UveLMfB|6q>l zN=}B~7f{e$rHB-XS`B)(FXH+mr#wkK4TfB)<|*}2r!B~^f|xv{y&<&GOVg?ZF|uz9TFlS zEg=dB5>ir<(%ndhAYFn2(g;X{l!Qo0cb7;iA|=uw4bt#EYro$)KlYDv?TbCGPs_WoRD`A)3uMv8J@e7R*t zGT$VzuG`t02`)t}OhEaYd+_pavdX{hSxyurL(Je<0?Lp6ZNfz5$yp0NnUA2)K#l)K z8u(<3uo)9%Wo9NvO2aHefZPuRu2Z`S?;Yg7z`m>nYVLf+OJp)$iQopQ3N&neR%O~_ z4_BU^R3_}h|DKk!5nHY#y zxDV+6>G+jvqJSAfjh7?Br1;a9)@z%hN&l!h7mxC54CeE(ynfEcK}dgt_zc?GpY^_% zD}EHH`e*b)$^L?r7GHuYk}xz@`=~0m-bpf0SJDi(ve%$%QqjFqXD|Md)@L2HNB4ap zWCZ~WxV7Bx*?+eRm~NRKFJ3gJp3?2s?O}s!10{tTMe2x8M%5f$ zbL}q5I-fEVC4QN>eaFoaDcw&KI`QrIm;NTXT<^nb=J-MKwNX*~stPUxBFlFl2M)@X z;PLzQgLp2H9J`nw_uU6O7bT6VZ!>z;4JM9;h>)OahT`1|h?)CYWZp{$5L7$JqZO3D zVG`oI+m6NKhAd_h>;(WqQmj$r`qPB>uiJ|k!Mz@xB!I^+Flm3a8bX9aBVezJfjo~$ zJ6QOX5#;|w7Bq`7QGAF~Jf3Km-X0*;eY`8PRACqESYx1G_2hfR?goKaKs=miUeMzJ zmgJ;IS2+XuoL^Z_N)YGYp;DI4e!H*-oxwk1wHdiz>kUqNoB2jrCTk%1lvv55inV){ z{fAKao>}SKntsbzGzg1)KL`84P&5DmzrnzxX!^p3Y^yWhfd*B^U?S(_VuPu?qN3tk zGIrO|`FUgaR&|J%f*^x#3v%_-qjN7mYukuh*-P}f<-y^+;KKV!6FK9KLOZ+9vp!SQ zi4pi3kFq7n$r@P@K>ZQ4KK}98u*O0ymt{!LAiaK&Vd(e~9jPFrW3OZ?O3Gmy&ILpt#$@H?b9-HpK zqv&QuLa%n@{o(L+eWIHB!9N>+%YSbMp*g+W{IOLX5CAX^D`56Mu$_4L9DtR~1y9fR zsw&BC-}pEF;;#N`f``dX{O7Nd+|%!RGIs(9n66o3MH+lp&YoJy@jn-QYVZZiHhLn$ z+gwJkuKiJ|`{obxV5nm$pEZK!KwxO5;Pl8lPkC9SO9SzXnx~??$|^($xoj za|LVCIg%SmT|^b|m~1ff`Y$FCdocs#4g#FPYIf^&@A0RHF5#Gyx`HW_8!8l0@8IcXeo zLajgpvrQ}$Ks7T!O}$4LRc*PFMW`pCfvv{3I`c7o46Je;N~Pv1UMJMHkfv`thmESnp7-jsRIj+iER!RkR5 zvy?gqA2Zz;zFszO>Meh8*|iFpaFbIG4k5F!C!uY`J$NZ`Tra#ZtKww)P&rH3I!nqd z;|V?MQ2OaX466!l)ja61$$_wEFajh$t)RvzGnguR^nr8W1?bF$5&by>{~dZ?*ueDw zE*%x9+K>9@=KNcU7(p>B4VK7{$zeTS_8Q)jAw&)^sH-)N9-QgM4FSgeDkTgD4Gg?R z`(D$Xve0FfO%r`|#Cf|~O~1J#e!d10RXerRP2phUilWo_k_(om=L9DNChZrebk{%Y zD%#7wn+z&v%T&>!cp(_k6dm8BY&B!p#*d|=`yAz)#SckY&%4rH5*AI- zo1?-mf2a!*9@soya~@nzGWu2fa}V-|QwHzC$61he#Y*BfL~Vmo>2#x{ED&oP2ib`^ zg+s1Iy&Zxb852{6r-4~sQ86_QGVSA_qM)`QrIs+M0EVV0$#4;uKhL%%SDl{K%P;=u z4eK|2oJ_xcUDov4jfgHdy_VE;UHvcP$`^7tyT?}F(!B!S^a<)hS+#R50?GzrJ2PIy z<=C*1YiWl+{}w2C8cI)}etyA!m^zgC&XjL^P82Vse4?Pn|G7o|<5U6)Ev+{fr!(vZ zKlP1k3x_1Iu+B3eK9WL;y;Up7@v7P9nAd%S4AIfi!KPFG`*L@W1DWNnUW1gju=@sR zyZ(OmeinY<*FbGCiin6P`TO@TG#4H}K)e3mMU}lZKze{yQ-rDw;m_r8O)Z3|2n7Wt zfQ5xQ%c$8)Eyde1mR>^=I~SM1DfhhBAe6QO*G1^Z>y7HcVZ(agehh{#ePXd&{6LI2 z7YF%RDp}cHt~Lsjo=!_vMRY8zNdf|bYK5myyPiKVGdGvY6!AJlDr8#N*){H*RdX7& zzFfYtgP#Pq4MKg9X339BB&Pf1S3(RjRFDBCFc;Dbq3G(LKk=vCrWN3_HRv7`%FPxQh5? zD=M?y_RY)lTWZy8W8c->yS?o?Lzyr95fv+J32erev!PKNWh9b$NPn`cuDebp9Gb-< z|4yN~VhE{27LQch!fmMbAqpnKn%zu^UI<&&C}r zn7X88A)S>pS@RfS?{XO7zf(4eWl<+szjKE6l~@y{sU&ELOGrk}9}YolSM z@!OdB@o;mO#@5zW0MccJ&vGCyLYA9n`)5Tk9G=2pC^GQkya~R0icaz)q*li|D(`uuge$}m? zZD^L%tPF1Ympmy=T>(gPJ{aHi#q!5~0<30?_>~Tw22?U7fq{q+A{z+k(^lqbi(RQl zc)ptnk`Dq1LnPol&{%AF^V{#oLtQ!vnn5g2lOF^0{+oc!SYBv^^=t9oQt=gy z(uaKSt2W*q{Rkmc)Ty8(_M~l6NHR3&E$bm+kluhaVFS|^4z}frOiza#pW|)ex@&T? z!{g&x4Vi+bZ-A588CJ$H;iWocl8ydCch4;3H0}DbY&+wT+U&RVNBWB!)vBwFqoX>H zrWUnk6e$XI^p-d@LkyU4P2Z2-WS2-ClB+^zj{`l)8|>AD-@#FZqZCSx$&q~T14Hvs>&dJrtZx7H^};h zxNfPfP~0Y+)2F{%Aydx>uxYI#i`HWZi1oHTFO2o#mbnd8{0yJS#oZijPx$OG$X!cg zjTQ92$i<6HhixtFeB%1KpvQyF~ACg5Vf%F_Is;FoMLowM(1X zY~KRYCsvhI4MFyMMdyF#1BzY>3iR;HUKx6Xr6yefKG>Xg~+3YlXuWgKw z7}e(;azzrckW0=b?=m1nT|0!k;?YKmrKU+|8~y)%jB>ak1?;;b-Kqk(>_r-QVf#-~ zfRYB1;j|*2v2eN9wx#DPgaZB<7_wTgk_Xt&O?Vu)`*j;Ckk|M*J!U;Mx>nBl?bFgR zFn7b|fvG^sHsM>6vQguHtRQJK0o#COx|tVhCzr)Jp5woMF1yBQ4`&X$SX@hpS4~~y zH)j|Q!38q3|Mf}t5PrW%Sks_tL;zO#TFKd&7Xc>p3ZUJ!GE$UAK$sa#5jDWLwe`ij z1S%Wp6O$o^u8~C5ueEbUuK92Me!-~wBV5p%5Q{hpYk!K{ps1lpdoh9SZH)bNO%#%1 zn;@L`Ww!o>c1Gi<$9sB0v3tLtK9|ch*hz}34*f^ck`)m0ti4GxmDwtHuNt3jnB>V* zOeV-vkZjCB zzhNT}np65l*JWH_cJypb*U(Kj`*<8y;CWCR;ww@p`NdIC+%&G`2x)3rkizOMyM4|> z!PsBiCqpS)@-l)FD}5W>#-Iz+#>hwQyN^Yb!NI-k{_;;34x;6Bg(fcnY&>RN|0Y)) zeFn0-^Ypi^w3oMpbOcl`2P%gK`X}gSW$VcI+7gmJM{RmaN%oF+gt5;CPFWN@)}&88 zB_u7SxD5M{U6Nk)-1NwO6YY3DA}V9#gWtI%oatKB|Fq4(9&ZEv8N39$K^-rWGYdA_ zVGB|#tTI!AP&pXTJ?)dQ?M@k*n z>fL%2;jI8l>90?i*5%pj$Pe;H6P%>Sb)_srUQ2w&HJDu8jmz#l|F?Z<1!5_$1s&!- zp*g>JkqeF!8`8+9ULVcH0wLY(rzw@;op11su0~n2GSgcpUzJf>hY)4pGL#vfj7Z2m ztc(!<<0>gp+^k)H4HmACl(6GmFVEaHRo}vsr|lq(>wJ%AJrJ;4t6mFV?Crg%_tPIa zD@|*p+Hc$)O((9L``OY_VPZ7)?%DSIiAq!V)>X>RJlu6Td1m8o59zA(V-xCnxZF1!6R3*|f85$uC6ppw1PeJjs z6NdLi+B=sAAg5u+YT7>&=p|-CLi)=(5=ZUXVaxu)q5^v5CT-WL4~AE(a_Ln>fc^tR zY|~`0;RRDu_1F0qoW&T@UR+4qlR%LFM|J+)7G$O`;CSY;7ay4D6HULzKGzawe>SKp zQv9BhC0LEd;3}!sQ^bzwUcpTwN!0>F^HH<*=XVvn`lMK6j&9VGxPEfj6c~ctk|he5 zUfyZB*jLnaew!mwg+$}P|FQ9-)T703I%Yax=JP>+eIwV2Fv66VkyuYgyE>#Pb%E)Q z2$OFYMYiKs>Lu`I92$r^fU2tk(MSXKC8@S3YDQkraV-sJ(X%r*9{;WQS#2IVzowSk zL;ukC=i~q!JJANctX_0>me9{$Js zyQy>M*H=#a!{Z<4od{quf)ArZE#&9WzqVlF;vFBF_f+?SeF*A$f8RYS{jY?XNHF zu-(N1;7r~KebDB$)AtQcL&qLzq4y5sa%cWO40ME+h~DHSgmR1zwBj*Zy~D8)cvdN6 zxM0+B2kYY%i^taNLKLow8$Qgf%dnVz^GxxkzuP>?5{Pn-A zSu=!~!rl%7h7@`7epV5;&H$$!7>A-`Vxsc)&d-}azP>U~;xZPv-9Fb*Kbi-HQ48Jc zxgNc0Z;Kb$D5d;e4948l%2aG~=V$lpum8%gf_M;mG_9D~*KpF_15}Wsie-ORP$&sc znqm>n1m266RpP$lb!t!`QebAf@YSSncZJ)@jbMIMENZZ5UfX2|p%8n@veaZ4cH=%T z4eda_|EbJmOUeR>Ug;kGoqG1aZ#!MXW$brEuCCw*0`rQIG=kf`qFDcGD@s*0{7(*Q z$vkV*c`Z_A75cAkn+c@y=F_l^Z=;Pat?pPf1!I)__;l-`=WcEAN2LrcqA&M^kdDO| zFx0)^)FhU=LkQ9DR5?%J)>?1eY0csY;r;uo8X$WolK=OtR!A2l1cXWq6Ob^XgGofRVJqoe z%`WSXVk^BjE)At@WRXqr_eG2lqQJv03)jR$iYS&#!a)y_rK`@+GjJfdtd%Ea)k2|y zEgS)jfX07MdJ2K)CU9;gu@8`;>D0Y-uGwKL?81~3QD2M`!ipWe&;vgx2JqtQbtCV~CNQSV{mj_-_Wvii8@`;zxml3$;YVoOv@ zWXM#v&@CsSH5y)l2eQkousaP3t*CbbU_eSbpo&PjxH{iC4#*VPS_Sp(@6`G&u1e$E z5x-j%dwWP@9aWzlSy}J)*&oG{n32YkUOj%0mUrJ+kt_b!er`c<5;xA;pM`~+_rTB) zisXD;C1g?b0z@_moSd8xFyIk=bK@qT)$p9C@l?{`mojn3z{5f#qdZn-rhJWsMdnZ< z8v%1U<$U{(RykLFWlN0G;4yE43@id^Sq@Mk z_w!Qy>+~w~-j~g}xl*A;IX=i_AcoML$f0G6jwFb}q9zCV#H~62 z3_`%pPg0@i9EQLOF#H;R2z$Uk;K(e5R#(3~(`dc=W1HVra7NIpL`fl{h{EjLMouwc zggWO{UlkUi=g5W&53!KL{ha!Qay7jZFjMKSIDPnvd(6q%V&5~LX*hLbr&J0EOV<4 zeamXCOOVsy=_#)EL%!3Gqgg}A_x!Sn{>*`{BEs3-9d@cP7ipT}(?@b|Mg32<&nwbu z?H$v!+GNiBrVSr14f|bR-5MyNksf=e&bI5QyKwCA1iPNJzD^;3APNBrPST(uswu%f zpbrx(bHvm1hs5ki$A?|m{vQL{@FhCbS>I7&EuMN>IylgQFCA(6DcybW_9`+y-a6WD z5Q9-#h5l-VK&7F)6vdpZq&+@8f-D0$Qcaj+o>0jBohv;k zlO?1-DTGzWU92Tg)DjIf5*vgGzSB*hlAr4dgG?>%Yz?WTVuEn6r;pA)IZ9YkCK*tNh;K=vR!I81=9)@V^$)B$)N;Jhso6{v}U)9!}ub2N75VGop zlVdTkpxE%id#LUb#acZ!3J{#{Lr6rZ6Gi-?#g~Fw`4O&DXo8v*H*!m1IMIZOsPsK@tw31MpADutyNd&dd&a+SI|7$k2_webe!vh{9&eN-wNh zmVuEX#dhRJru&aig6xqNemp6`gQV)Q?;Sh8mX17s6}477!L9U*Qut)3O-vL#gjGw- zdzBSKhzdZ%AMtx-r9fF7nccR)HWO9AX%4^b=RNb((D@r#UW3VNCyr$TW2J?meNBz^ z`_!SaT^3E7n&gR%HSzlYw%w*G{Ccx(o_(aiSR4OH_@3KP9U~tWB7h@VHiSPHCVq9Y zc#KTTQ86*Yzm_+6@G(2{!MVffwDG9gW*jpR$eXc1g?|LnDjQ-;(`AZ+SHC;wmAgHk z_=$81l#WWit6Aj6>$YP~V*V$(DOh(aB3@!R#+`q>jr>W zjZUQn4uW`L!K+|6`JU~;k1cvy0%5bQ?VJ}^b(IpwY8dkU7jjtoAsPI-Ptq>j+y0eM z32*P{_x!w3MNFa|cTYa7^S$XhgQ&jpruvZgdEVQWeC`Jh`|Y2cT28IPVHN`f%@pV@ zir%StF@W5|l_)Q5X^{CH-ii77>xv5F>OeLgX{(bH;K+*d7&koVd0upWn4v=5M?(Ld zcs;zoIB+h3lUnk2ephV#lSH0ryh&Wf(N>_?FRXZU+~s> z1m!FrUsnz@H*9-OPp~}u)IGuFd|3QLhVveOu4`Gqh!SU2$2Fh6+^yM{R*Ipc=oR68 z8wmi64!Hglj}KQ@QS(tY9ru+klW&vsGahf z19jO8DRTmINHp~U1H(riH@%N~j$YQ=oypA)r{bC0HZ*jera=W{b(lnPJv`?XDyvrQ za3OZT%1?0WP8zPf+*)&p5eB-Nuz>X2*W9mO@8cv{Eph2?h>Z4`(*dPfmJlfkvHv{jB5nQZc7$Js#8( z3d9C9+_nC8J&`vNf$*^tW)%fg6$G;$y5w9!p@x;!=v=>ZsKk1DT(djJ#gy&;rG<2s z8kHXnC5lAjBkCxdBD#FNNRA+GaHC(u*{pE?5w2Dx_RpEXSq!};M7TVrzYxgHP+|zN zr&V!Q+uCKME>QNg?)|N(o%7zjFDYkx-8qU-NIicdE&V(Hy^&dPtXjR_YjN*)uTAc4 zCjf9Q7dAeKz)VqZ5kG*3Y36B_SDb&<&fYtEvqTIUrjI`)NUD~^lG4a}G#}lwc~)gA z0f58{O z{kT&G*p1(^*^7y_w#+_8Z$%S;N!}4tj7YqCO)=C{VDw6CUw-e({Yn{|A`QiK=Gj13 zZ;njFug}-Evl=C-RE;eU!ZuJZ!g?1h{wzxPH%MShf5dC&qKT#G#2PUl6r|qj?hdBp z(sT0yWFZDDe`IxwlrV$$OrV4nMzlf34JIWaLFK0=Ai&1%lT%V6cqyDgt2%Zm0&Fop zhNXQ-lDliUF>|9%T4eO%mxrX-42*$jh#RU3tbeC#%LZX}_KTGz-|bggvX;~0C@nw2 zouBlhoq^$>4UGEHY--g<*w}oi)EI@52({h7S6Jw`ehURMA+-PT)T?Ew;>z*ee)c#? z@oFbdfkF+{J>s?&R%|?>!8ZiAC6U3m(OB?Fr3L9(||g*RUucqKN1Y=qfj5BE3JZCqOmx z?oEx|K>Rm)M&ds;zeabbdgXo<9elaX9x!(O^2&|2tp{jCNDL;pvk>1W3*JKjUXjiB z-<0)F@DRNQBT{2nX>LxyFQW-UwYqyt?^M2B@AcB_`-t2Mmi)jA9DNZMVd1mr?%pAh zy)M$_>sIFl$rP$7{f0nwTj)m3YXR3K;M^c$_=ogehsTz@mYTB>5na3_^V-In!igYE z!KcE67l(`&1c5OWBPC@#3Lm6H5^xAVVzIqM=~iyrKL-BU?2N#Xl_c3ba2{z>F*}hwC~qKS?|$ zyjoMDc-4LK5l9H=U?GY?xUEl|u5-F*YuTiJfABI*2<4Rmif()g!b>hY;gvQv+tdE8 z=t(i@gIGC5xJ~rNu=+0hDvaL~EH7hS4}IZcRb^$8Zt0I}kh&C?!e++|yt+J(c?2~O)APhh))lg;N(|GpcA7OUfc2tBi}a%ttEI_;X1tL&2}Y)#FF{S+^*t^h}t z53+hjNO-|)NNh-2Ei>5ZfP#hn<9o&EchMvE%AT=^iKQQyPVWdfq;BxCMQy$Lm#@&A zbad|dGt-p_wV$b@_T@vcoqeow_v%-#mc5T7j6t;L{ElZ|fxJH;{S&{c;`g9QcF(jz zReC525-R~iRxf@*&)&)!LZ$*0KY*BepmTu_(%j$-APs+ztdrILq!R=`#%%3YQ{u_b z26s+{*KL(!;-!u9>CZvgt`XM%40o8BWfYW^pV-=R;Nsyiyk!J{77pXQHN+t9A{o4gW1I+etkZS@4 z>8<}>^Kr@v7%Li9m9?DN_JDdYIavJp2LQdm4nStXusvUdZAw@c6(!oG2%W!XnCf)I02;>{7nG4}zIKSut0`O4O2-^A8u zzfe$%9#FYV(|&zOcrQU+RZTk0C0M?o7qfOvSIlxCK>z{o#e0hg{PA+!@F6%1uAS#l+_D5Q|iQ(=RQeryC*MtADsD}0dH6&wm<1KG=X(B zB9LeD(|S_M`|)b;MyoG+(=5`i^(iMN2_a@v8HM8Ik49f(EzES|<+8L2)!#xqO??o4 zGpxNZXK5MWf0P-bJ}*70^_rtsy@UbM0uqjKt)D^T2Q>05-k9-HX+8`5JKK2tX3|pL zB0>EK0{SJmg+1+jb0dQ4zPDShk*K$TJ>B<8Q;l&ef;3RED|Z;wBJgqBoOA9fUm(CF zpe564_I97YK5xA~sM5LHBj$HDQ$7dPPSxn1px0hEB?~o$m16H zQO(WGLR@lt-JUATJEkPYwfo$}r;BV6Bkp!&oe7a#K}lgkeE2QGy`;Bq+CSK;^Sp-k zbnB$-tqgsDI=YEXR&SOnIy#mvBzvR7KBgG5q{}O?faQf?EueRWi0DQIXgH$nP1$7a zAp4gupT3uJ5!kDTGH2d*%>E={x@D9hH}fqxEJlU4{FAuOf1oZD&wfOl!EHs`vy+{GivFB0 zk8tS4)Py0?Tx`xJn?FW(cHadF-o z1i%D&QNsP(fSbJw&X6H0VyEZ`z!B4A&;+lim|qG9A|o%mAC(o)K)v!YX0n9?hq%kJ1O0+A-*fQpFpJzWm8ic0%(b@a2s(&pxR zYw5+=prG3G|Jrbboq&&75Bca=6#=WUuv^3Dt-It zXxb@_rFCy58%Q0($?6;l;W41m8|qJVdE9!9fjHcmEVD6H8&&N$j`6;1Ac+~mVG*UO z4OYkPUz9j7z3l7$Vn>ATzfWoGtA>VvG}npWWuoEAqMVM6_*v_ewZ1l*`|i);VlMcc zl`mHfi%nyf8z^7~yZBsB zy<*ortyi%mOExXm4i=!D2$puU!;{DlTq0(O7&GMDQefxOB}92Bfndds6=jSk%*uIR zyTz39kw;>XbEFW)s^E35pLc&Pciw9?!$2}jhvNFIe7wayts+GxiTo<2wxG0ERMtSI z+x}nh-pAF90mV@I-d2?oAx{$GTXTMwg7bgPlT3Lz1kHOQ+umFv*qh< zh`q_l4+DwJ!0J;Ln3TyMs3Jqdz<{`wz=TDC<)IatrxWy|wVxyp%Z3AyVEE-faN0B< z0f1Nl>))2K*7K?>?-f0$$XSTL?2Ogkb3QuHvx@nb9gki+gfhj1YMHa($W~E#r25#^ z=Xb@U+YyW%k7VL{#Z%s(WWiG&*+;zFqnr+?zuHuyG#mD71)*sa{Tj#biQzG@rWSV# zb^zq7<+Z>wy9Z2M&bd~#HPUVmA#YqT-+7Nkfc26U@|2Xnvg0vKySF|w803H9^5oDvl0^%#Q^s~5JGegY_owbtl;(&sVjaISHR04n4=;PCR1bi zaZWHj5EB)>Jo(|*nCXh{Gs;TQ{Q4Gsi}J;WOq*qugj>B68QyVNB`tBbbYz&aU{hzX zT(1pJ?tJmJ>W-Fsg~K(^)+&$A?pD%{U@OS~w;~jZMhexKkOjd9>c=n{MMM0ZJ5qcW zQO(AYCxf=3U5j}qrtcefkFoINom#99boy;nYIM5wLbwKJ(0Ztn8 zaTO^6hs%X)*Q(0eyM~o{^vDhQ(TB#9D+v8TlYdBmb+20Id^4vDU)nFfAF=oT1F}Re zJn)qD=Hi^a(;zC!mhWwK6Ekrl~=x+2Lz*uLh1>A0i5hkz;{4f9Q zhUcYqm51QHYV)OGGDj6`wTmz(6cjw5k2@Gu!fiifM0&Z`& z84AwgupLJc@zb3hWmEy1Gw}wF6Mv_Ih@9x6Z$0|ad`zlxg4$L)?>~tA`XnpgG9o68 zd#Wm&2gkV; zcCBZ&L7Fm5-d{82=)IhP7BX;7VSA*K!K}az51%e6p%>*t5#xV|S$&hNAtcXk-mlSR z{C)0|n18yh{-R)kc=DJq6PCsZ#2;>>&z5@+2^Q#b*%oj%y}zAI_r>G;#o{n@*lve9{2Z_i9W<|=#f?{o^{ywr;D>Oj0fT%^q zXMv3{0a)*m|F6^Wzi6XatGdmJhv70#AD&DKbQ#(=+G&<RZH{ z&yn0B@@;Y(HD6~hqM;A?DQ4#TGz;9S#1zb(Qd!HpS1@a;t~MuYJ81 zO^|u#0jkCNSpIV2XK)Oi+J);q?eX_)o+?X=;CWX5{V;7EUg?jUZpTV^KMee_NQ3+0#+y?;;-2M5&a;Yq$mcA8v7Ai1FPe#dl(-_uU5e#M1_Yp-E+ z2a;}cBIJl4WyZtEiihJpA_XWD0MA4qVDTrlw6NBxzrvkt{AhnK`b+Q3Bu<&SB=_J^ z;VT1521YVHavMP#DhH7qdhYJtBN2MiM$@0W3oW4M(E-lqx9ZxZ*pG(3eRX_!?}*yg z?YYDqK}9j^nNd&FG9scMEka5|{f7s2Gu4P}=)1l?#P4bC0wu!%sj?@LRHME20>hjf z9B;1yE2T{;Y5(aDIebkw)H}k$)KJ@^BEXHk%?EfvimTko+KrC$+=p?;J;YN?TH&!J zt&E^!8Y_d7E_r+C34S&~=y7-VNnJ0uaox#K&DOLZ%tW4nPxwU;wFu}v;wa0@JAU3f zmQWq{*3^^Zy)l4LT!DXJL)XRe{|{;&9Ea=#M&M&!5Aw7|UY(^K#Y}oPk#6nJc}mKxdmry% z^##Q<<20#Dq_&P^33#>$avRhi{_HuL|MW4zJBnWX7A*Zr_s{FW-i0K{Ygg5zVsL7p zR*MS1ou!WiuhnekW+fX#wi*{z3DzG~H@B1N`&NZ0zrke>`7!+p>{k|na_bL{1?g_! z&q@L8xv7hzNnLhtYiXk)^lBZ4;2_S(g8ghbIGMjvR{+PB2fPdn3o?lc)jI*# z=ku@*Q#Di+5$maxXhyR?cQCSwIi zGjojynCdVNR>k+ALm@;U-t}uNAG^Rf(H#{H^}L=8T|#Mtq@Sq*p3P9m1A>^TLuzaZ zyZkPnXSKN!&dtd4L6{Gfdmq^%+Cp$hh0}&s@?i`m0#!&EHbXQlC$iy3fc_e;Jx*+; zK`4aH@#OUMrmczmgEg@O@*Kj$;Jf{VQMn4tH}%AsY{ZXbigEUi&!M9!F*7rxMzlfm zTYT8!_u!bx{qO0EC+5|UJwrnSE0It1$m!0B;3tCW_qXKx3|& z5Fl)A83n7z7H7!(NFtnIH28RJL1OBM*-1(q75wcHxnP(`*yMo*-NdvQ{;V(tct`*tIjl7lf5RI-uYQIBA%j-JPjFYxU85+NqajI(aOX|D@K9!aOxO98fgDv}c zLt_5`S>^u@JnQ3MH4b`+wxewP_n!OzW)lX2yA2W3s_Jf!I^yWw&^lTzqWZo@{< zSy_w0qa^hKr(a)irlzLgp&*9qegrr-TA?1!yxxaTr?(fk@jT=u9|!B*;paqyl5|6k zou7A*m+CmFk|PR;zxKKY22CT5wFe+?kTD4(j(O0tKsyBZ{(r>}H;Ot%>H#ca7J*AN ze9^SITFx?jnB(uxbgQ^2W?I7XX2WA~b*H|?I%;|+?~Q)eYcvGlU^N|$#f&fO_hFKQ z+1!s^wh@%g2P4$Rh`R&3rF5A2K-&rlX*gIJp5!ZmXF;A{1VXFKXp0iEh%JEAqoC9C zt%mB=9S!To9T=3DJb}4HqDo-G>lFjVr-!H8jXMPcdd#Uec2w@XKmR~UA3~&>0^@p! z+cyc`+WsbgvGO+=6vVhST>_f$-}J>&o6>!e@K=5QJ(~{?$7;r}eVdLNJ!%whZ*Q+% z+;RT1nU*QNxETVG!v zP8V_Ks5~wA*I3*fihnmKjjhn3FwtU^clEnBHu2ro`8P;ssK^LWLUQg52M*CT+8HYU z^25!RxDN@5^OiHDD3a_CgF-)hBT8qpjcUWncW)yv*Y*pbDIu5r2wu~UkU1eCp#%8e zJ6OdYlQVQd>23dCg(QR_2bNT9`C(DvN20EO*EC+&-XO^IkL=6oOCR6F&CBagm3*xF zu3@4~m(G9nAAOoC$W&;3DkN!COce^dU65ssjw#AB7u0-$~(**Ug0wo$ND$GUhdq5#h zm{w&VSu$7%5Uq%BLWWnNLQBE-Zm2o=7o=OMu^mn(&rw|Doy2>DZl@Z8Gah zn;4JT?+~37`Z!+ZrwrxSTdX1pb9K=i zUYV+E!Ah#@50KU9GrN(hbpiMWu_-Cxz}NckC!1D?KTK3Fazpw?7nPMc^}y|kf(qcC z6tWoLe2g#wO`tpc{MF|$_Zz+JoD5sCs;93FPVg*M-KfU4nIkiYaW4qUJ zAET}JWLsGIle$=UYML>gP6;w*2JH~3?4A(i0=?%uH27%4a1eHB2~lr1KP2^e@yEHC zmr_8tMIuC1wNE+q3#9_$4 zWcr>Iu{PtGUcJ)EJ*cS{qRJsaBmz@i^_IvpmK8()*-D{JSAuB{1q`-QRabv}ZqW=C%07d8TdDcTMvfJpt z5XRJFpIT}aKG33Mk3|q7Mr^9DT2KlQ`R_B;>o<-)7;fKAK$VXA;ZOX$;Fz1h{A@fI zI~+CW*KPb8cCULcq++cHd#?G+_LMek>=hn`<|aM$w0X7XtApppn|eENj>wEz?Pic3 zsqOP-#jCbW)n|4g^1p8f&AHlnA>_Mt!@foJwl_)Bau`M@za!o$XZp%X#xwCehys(| zS+g014TH>^3%!~|p;{O}Fx60$D)P}{Y3&>;0!B}s^e`$K0=y+L>S`Qd9rI2Qpu$hMe4 z>J0(`+x2k<78a|*S;rVdNbvTOVGdANdcuA&w zk8E|pK#hCjX6MLUEp@`lVxF5C=7yKH)H5ei60YzQp+_iFIrtgbA#W+OR}xi8iCMqO zKeYY!B=!dugY8ayIafl6F%GVi^oH*T*?TvZ47%m*#G1YYVQczGp_~fb4@bw14t=Bj zc!)iFL6IUO8#Au-p>{&(Q(|8B?;|+4eT5CZVMM43>~1YjmUO?$$tzo_Slx^iXMjj> zaSghyf=${iVvvF|dY}-Z*D2N7dNC||yq+5)=Ish!=&3I+Rb(;KV_2c}8a6pE*yzR+ z{j9seDSGz)NLF5jNU9viTb!OpzoK;Z@?>@_lS?FDgP6>%xo`ybKi6Z&Tvm9r+>~T` z1iOK>w$aYz4f`%4;>7*&)DB8<&kMiLi;+dB2Tn2+mj~(o4+|iyQ_-D@DyoPjD zml>taWrhfW^n0woS1%qc`OGj^(PzgNhNx!XEKoD?ee#my`PRnoLyTJ#_)FLroef>C zmgW)LIE!H7rA&VV4nnOUmaRML1)JuxLQZ$;Kh6(TP1sE+Z}b?mFfU&{O`83?bUh7T z+OO0H)D$$~qVyu+hXzibjsBP3S&*WY!Rp!W2W%Ua0B^J>i~!9t!k^iuPuh9n>nRKA*V9v8 zZ#&Sk)bTS)pbb6A!QZXN@%*62<@P}4cDEPGioSG8zs4J*BH2Ja!comI+V^yf3yv;) z#B4%0U0(Ossm7uQ?Gin_5uzTZ@tCWbUQ!b^=U_i>vm&?8Q6jZ7NEkC9q_8>Gu{x0C z%7ZB?0e>srwKab+J}}tmgDhGwj+lt^Pe+NMHB9Yp4D9?s$&xp-DR@&0sKG9rj_yNH zkZ?BAuMMXQEjBt#3jij`2pnPe03lYCn2{lY7lEs$^ISqrjlqDMb!n_zJ#+QL=<|iG zEi@+{rpPDso?fS6z@v|V0lD~Ot}G#-=2dUt;tnu{TsWFMk(EV`agJyIA5C8YRb|?R zdkE#wAt9)Ary?LAd1w%%6)B}Vq(eYDBn2EgBn3pIOG1zk>5z~P=`N|e`R~21nOTm@ zrRRLH-@Tvx1i{(SrWA-GcEGjc%(`-7g@RkJ<`f`0rJL79%}>1>|E}Op5+tQ%K^q+c zW;h|BRX5kxCTACmfe!ecB9Fwm@@0b@3D%uYH&k;a-NyFB71RGF#!DTQUV;zi1Cv7t`GfDsbcOnBx=i>l)|9b+5YMlA6WS4;3 zY`3JD-xn_a=-I{j@b_(|+WgxjbTov+Y$3*jM3cLZPCk}A6(ot+-*NI;-ZrCWMKopx zMm@`F)<>lLJ;#vCkeCg;qrykYJFF-!ZSjUSl$`N5*B5naZ8;Mz372HP+vTR1wjqb?6|EldBy-pMOgw zBt^drNJqfuo2^|*=kV2M7JKdF^c~d5lDIf~%G@7*K~zq}dBMQ<7eC{sHWa6rgxJ`^ zUPP3v)zsvCyKzH6aKrBRJ(0VvqSDcM=UF%%jt)ZZHEE>n+K+K?7z;E{V@ys{_9=X{ zCN?}mMcrCA9e(?kXjD%C67oWFmfr)=Sg!wo4Iq!~Dz0g~=5*b}r*iJw94yg&q^j5j z?@2vu*Igw6KJ*0PvDF|jUgnW>gB+y|gZvB(#*&_%|0=;j;Ef8>Q6-5t=z7_#c8J-T z^e~@|2{W&bI8bp<{}#+Vf5|*gkm!49L0^7Wh%l!z-1XMFX%Y60Gla~jwzPvzb@K*I z5RO%P2&2*$&%2#2Ih6)`v3Nx) zxF{TvsqW4oo%>d|f^J&v{OlWnua`KQWQji=ACjt47;Li{q!8Y&rG$0bMPx9SIPT8N z@cTK!j{@E5&kSN>mp@^`D+iM?p*zIHvA}Mezte`y)qIrcHuKNRNJT=Gord!Q&5s3r z?_RB7T#DZWfAYrwHuNw7T%(QlCZ}+Z*0(H}B)KsK=lKgdvI>HvXtZ6t^ano3F;9kX ztOTo3^bU6kbvR}Hf1yX%-(UOd?WmpM=)0%9h5Gffn}$!N zIi{~>)6`ge9!m(R427?}8`6xqFmw6m?g(`aPKVkBp1fRr(Tw*gR{IYNM~{4r zi1zkNuwm^-dgyt9kL?D*z`)LEVyS}8M>VtME}P&-If#N z+p!J(_HFui%$GYW`mCkP-C4R0K{u0*DlMXwlg@KoMFg+$_XCzZHpck^1H*MtQSiI&MYTqUoatS(VbQBlCV9b8M_}_QB@~U`So|1_=4Ph znNWYJyYZoXm>-4bBn$EEb8)!UP&w0qM3rb=b`M$Sx_zIa(T=8u?zbo6_+lXlT3+0G zaTaX!QXYde%-pfXjEh)QOE1VlgfOW)hA~#ZjE0^)_(nn)p<>}BSQ-hKn&ruC{i)Vy zG+Av>TcyNKl{MZl@7-_74yu=UiB5#{7uF1tpAV9EKw?D`Iowag{@3KC9q(&^9`x>R zr+k3)`MM4Cb(IR9V>lZgxL1^xnD-gz zFvz~^WC)CZy0Wyg0-?>@QJXIR4lJ)7h)NrelCvQS;Wk2#o8k{_V6UJ%XoAN}JT5i$ z+ya=s0^0!k-=o9)UysDjB9Sa$3rkG^k+hD(rW@5J7X#|g|S_rpHl=!wh%cWL=n67TC(&2b*D)l56?Ohy@UI1)i@my8h?Y;OB3mb zf@$P;d&HvgsVMOZuk zI5rF2AdJj-G!;_@Z0NK3S8NH2)u^nRrC%d90vfPLzj0rHfdK;ydyc@%zZB?S|0cl& z=bm=aNC**n)C$_`H&ttrZ;1#rzs}{HQdv>%M5e*MB&VMQ)GCFNg8p)Z;i?5{ce0~Dx z!)_}sPkaPCCO#n8%G=mD_{Z~&kCB~w>$P=mYrXy3@lc*7L2PQSm=F5VR`*kH4B~LPbudGVBg40$r0%YJ`e6wgDw=+xj{Q2btqoSQ2pl%?facs?rRot%v1?+aiN`7HS7HuY_P+DPKpW%sOt zZi-4#p>LtQ-)!C|pddrFIMN1wAD_SJE}D()i8a#EmHm;)gFaV>K8u~2qjXEIxa2mD zfnRw2<3D7A=^@=e5$LR%idwgG`4E0T%*tDg%9@SJGBY!06R&u@^c~BdbFy-C=K){n z8SE9Sh3TZ{90Ut~F8L3w2C{~44G#~y!fwF#UryocP0%ApM%#D^L@hFBs<<0F^Nlpiumn9Pry(E++A=b!FZOfe*L>zB zDffCV@8E~Z3Mmm=^n}64PN@BTm74OoMCoC^e{@f*rStePLVj7^fA)8TP8~ZdSk+k| zDC_ey1q&{3%-_AKSx)S`SY$jBjOgsi8KDF@k0aFZnsrrCztGyXrYu=<$IuWj+Z$f=L){qsX<=kDHK_f5Z8200@@U#>cX&B}Ge!5KvWaKF-;_e*_j8?N=M zz#05c42TT=Fq%5~LRK>G&Kc38>lNb$I;L6qI9im1G2g7A5>6&*U^hbWFR4Mn$K$tJ z&MnNIME14*OI4(yad*(?vNV$Vr9Vm-8Q`dpP0kh#$48{4&TF;_uYC;rK{$uwZ~c1J zHpG+Yy&L5N0xUe75&fwR60coo?Tq7%%hkQtAPV}y-?LUYDZ0mn~AX4m?A!0fu& z=g6L|J~*Wm##pRDIy^0`dWz=7r;Ln`arj0{hIPO!vUTewPb5-H#{&b^+~wM)>l8b8 zC!Aa?E0m+Rz0ioGZIC6$w46p(`M%YfH`;ixbo~wTPm*qFH0U?{^=}mZPPs*hb@G~y zu8YJwjThy@%=ZA3R(dl?`Wg47dblT7;*uiK5wG9yYJgyCd(yVx`&=d{0S+If{4%_a7fb_yxgeXc zu<(ixsW?oT@9LQ)!XqMHl_%&`3+C>WZej+#>zU_ld;Gn>v+031|D~Y)FUe2kNDuBi zul3u%gi;r{GrhCo*~y&6v_HW4Y-sQ+9GyrI?Pe#DAd`0jJENdwt;T=Ltp3SUf6@n; z6b=z{*e(&&KCpb66TjH@eIZGN>~Ng*xC~y>_SIldkS^2=Cy!v7v8r6&6?r;r#m~mh z{uSDf74uwm1ub?m_!UidvWgcaoIhXt4OrM{m9fon{d$ocQL4$F1)32tF|jVY5DiZC z&JxsPfe`LyEb99Gw>BbO#ME|A(R_YAmB!a6rLx462wD!riIQsIztyyyZ}jpdtLF{= zz|=QnUEGiLzG9*TEik!+Zw{k08Y$+vb^+!IR$GromJrVNN`3u^RH2v9eAROLC0;NmM6f=}HJchAwD(Txy zRM+A9UxJoBnW@O@X#BdW*~jtJS0bcj?$FA0j5 zQNjO@-PQM*JG>_HxARv03}~K9G)+iI^&6gla`%@K%DvL_zJs1eC>a`-0%z+$L(z^p>%d6$P1!XJ zhphX!I(As@DnT!TUrJj!e-Zpz#4J2-U10!1x>Y zWfq;q#%A>UAj;0NT1D}nf2tOFu+UTf2Fu-~KfFY$n$gbK@pzEyniAf6JGty9Tk=-+ zS2@QK#x+M+?fM4KJ#d^a!q4zN{t<*w>=ERBoLWUwZ~(!az-ec3!C((EZ!{S zHU4i3^{${lzF>g#=93Vqi6>9fe@hGM-KL;!iJUAy?$CHp#v-2a`1s=m3_J?JwKnkH zmGK5zZuNN(ob+$i6+y{D?gRVnNy>bYNac?M&CpanQd~7a1lefv-hRiQ{HT(Ct7!mb;u$oW%-HLNb0}#Zob#T)q{2B$Uo?mPL}VE;H!|YaAgo zQBUkR1y)v29`7+&9njrXNo)ShhJ9+~TBP2h$<-`TkDYL_qPPV8>YpoTQGoN1czEYS zeF||V@It#~2N0ne8XL1zS$P{98c1|2EF3=r3t=51B5q3|%X|PJE}$kF4%A?sbJe~` zB19(;h{pebTR!Vd-YR478KsCM{ff1Mqdv>PN@Utk-)uL9b*dd>i@P$NlKq9OBd%8AOe^|o~R+bq_J&W7&PmyjSs7_G^p zmez>4-6aH>+y!Gd?=LhY(Ei+PEAdQq3Y5wdC1lxuucq`%@_SLsckSFFrd#OlcUAt5 zSh*MSZG`IwCEb684$gq#|Dz+3b3X6)oT`b9&S-MjTAJ}uCUmL&p7kSQ7^{z%i5|(- zC^)c3GD_I`grjihWf7-SU}FIvTB8-zfr-9zPwb_`cUeC1j1AX>o80Bg!H4 z07nj=Ec*AkdyWvU!{Doy(o^gm^`!fa1IEZh9RFAYzi}NT;oMyQU{-$uQqkQZSGQz# z#KIgWAZo&aHh+iPS>aS;PL1U3DO(wtPVUsyRNG^n8ADr#K%(Wp~CcAMY8y&L^RmwA*i z$DfFrT?OGgB<7fk$e;ATXW3CElc&0e9-pe39-B3LGmlGtiT zw0%0EoFDM1iCBfutmFmL-w=d+HOic|(|ao89u)!wEm9#VMj~_Byy<_2@uy!!SgRK(FmwTLLqc@7W_@eUX+Y# zSKp$cio6LXWIZ5gzL)?I;Q#{_TJogl{w{cyZ#{A&Wi)8=c_S??yBwe{*yH9)KE@U? zi;R|kL!^lrgRmeI=6f_E>5`tPbdTUJs?ln8b?w){uSYdG=tMltnf>(gB{y>Yel7&2 zsQ*s&5HxnmPJgQGEO4_G8rl}@`>cl+Te?^bsFci-55(zbF^#&381%KGU;g6~GKARO z%?rW5B7IKq0X-WHj&^rz!L+GS6gU8SU%>X~6)0cs@PbaY4{kWXV+p=2yu2g`RW81G zcS{$C=f&|3TH+mkEAAFI$oS49$#U%k6_8l`rGb)J{%hm}qH^v9LezF$Z;M7bQ!5x3 zY+f<*PDQD|`u^duhN1ylqr>{)RD()nW}tzp1na=b(u~&Y>TN*Ky}IMp?6gjPt13zg z5~wH<&mk1@hsw17YK5Mkd;gCTi-rJB8P586xz|jZ_{Ep|Jbjh6XH^Fd&*tRULNZ=9 za|8y|757LLI$eGl7Om(0+P!6kGfXS%jcM<#v5x#T%vMxu!HoVim33~2g+g9<< z0MwH-Qk#ZDm0uVm7D|F46Zze z7vBlRr}hJ=A(%poJz>|b+RF`YXj2luwKg7ITOCO5U;~c@!b~g#XmS6!&EVq_=5OUl z=jh-l=$QY*dVqaFQ_vN6iRdA9)5;7`cP|#u>#C`!uc`UnQ>@PKzMA{N&f@bU&x3-h z2=ZTETnrD7$M;wCRA;f*0>Y%jI&mIS6K>gb%*4{0q5}OS!hW<-6wSpG_W%5l7;BB4 z-yvXU^`_7`U;DlJFV8DqC@8Mpg*6X}QU72tKqLD^!JeQP7!+j6Z#&`q9h^|a1Bm8X z*L|k*pVA1ZQsT*u+@b|Sh-uWysntkPOQLnlADkBU-Nz;-q)f(2RTRP=XCIYbGB{-3 zuMhtszQ8ybCNAuS?LdsKO6k#F_&npY6psdy>Yp@i_yS!wJ-*>vA4S5>u6( zE|-?tS|~H04KLE0VIXc{HgQUxO|fMzRY}mYTvCUsBV(oWdlEX!p7d$@6cv+NplB1q zN`*FBWDn^kj@b!bi`)qJcSLbDzE?irf_Ddcbs3OdbhmeGI(Uhk$}IcaJW{*q&j29M zR$+mYt}Rg-H^RG0yU6q*t(LSma1L%FzJR*(`_>_hp_vg;HvlEUSym*^%L{N-+{EF-8S(FpvWFs1fJw#z8dxANV*jftkx6~yU<_EnU- zKu~6N$P!)AH1%gw;LjTh$T6x{vmU=iTyrM4So8eq_#}1XL_>c?wA%}jvKyea|8cFt ze!FqhocNy5fJg*h!m_D#jP$fLe3U$$Uu(F+I!NQrlxD;ob|kFKUa!5nI#N!LPwk;G znUZ38$H3ZK)x6;R(Xo6q+@LXo_Sy^X;S;7@PL`}E-q(tqO|kQBUr(X5#XoJB7zZaY zR=f0QpFa$kwl0(+W7mb~Ux+9S|5b=6c2YRFR8F%RTOn}$+rO9487jP0{=j_lLpUKk ziAz9^^u&6-5o7nuark( zxdh#&LLo_|(b`27U1%|P1oc@JyZlkP>^6{HkmdEJnS=S$)kw}^N-Ex53Pg>6CQo|x z^MTaD3O;++#uK9{47AoPRt7BUd|ZC(k*|2vBF}-4E&^9%5p0Lsfs2bkz+!BuFZp8n zW4;QF{$00mYQ@~GVXTKgzn56l?!25|*zSsnYx5?!Y1DS+ps2svzF$5fn{m=7qox9O zA$Rd^2K)r$027!1$6%wjql*f4I@y_fUTH;^atH-6A^fpx$&?kr58y*P4=Tm+ccPGHaiP7#F$(>9ZH_l`3&X# z0x&PFUK$xoL`>WQTd4S5QZT|}kpM?BiN17EjhwEYO%BOSD|G5@qd3!iu#t@=BC%xG zsT<}8HJwYw)TIb!h~$^<8HB`WuMUCIA>Wh2Fi5DwTC+`?#!*DkWQ+qF}%G_ zKfrGq0n~W;kFW-_-`U5%ot?*2NViY0y! zg-hP!3By1}_gf~df3U#sw!jIRZ@)zgyQK$XCAw};zn!0k)y?t*nXSIdIWd1inZy`4 zO;1O6Sw&eTvfXiqlr)g2)tTi;MSd5>-4-IFsGMKer@Py9`g+iE3O|gfSLL)|bBlY< z=dne*?^D;3kodutUnQ;|%gv)pfduBo7Q36k*(v-gGd$e$oKU9oVnsmkJ~4~P;^tpw zS8yjfx9CgfQktmVo@LLiU^i$Gghh_JtVXW;O+e{r5em|hnyjQeQ3xT>bE1&2yopr0 zhTtjI-WbrTrNv&N{rsaZ`LEH0(qox7Xpf>Zb$20}uJ6pz{IM??$1{~Olu`s?6cK7@ zc%{Vsh#-;Z_Rzyx3ToxG#vEg9fzjP=_C7)&;w>#ii_0pm-Z$&{JEu1AYCVcNlFPIY zZ?(;B-shM9Kf99*1Em;b@qh;AJsBA^pM<>O=<&*-Qkl+QN_QZX;J1{b0-VLG!-em8 z|3hWDKfsg+BNxO8*ps<{22Swy9ipDbPz%$Mj{Pt4PvuF?vY|u4OW|Eilsp4^ac?Pv`IH_3q%`8I6vp(<-aDrIaJ3{ego?>@s6n;j?QaNmy_|XNR-pcefM6xUGl}Jt_OU z9gSWJY~wYK3|5 z0O3?msqR?Ghxj-EpE-!LRap)2(7r-*1B(@Qufwg%EHGeZd+YTS3GPJ|sd6#zeG>lT z{NB)KY;EpUt+CQOxi=_O0e-xLoJ&Fh3M3S_*@IN_G4tn>dWn@w8UF3L=v28YBwp3^ zXdoT?e*RRVToKO!p$`DUfuND>nQLxoWT0;~?qK?3o1wL>W*{S)ev2+nKhsW0cdqj_ zx=XwVJX&^RHq!70E(tJyywMC<Mx$>VGDcu=G|DL zH>-6HuH6)q*)AL!RT#x5+if8qK2R9?oaTQ2_NHD|T8`-*f37o&coPyIi%Be9gV;z$ zd9K+gDGu~4f`abTMWrvKJAtm!0uyZhyIfV)z0Zg)v#qJxJXnDmyMkJ~w!*c3_(0h7 z4_2qn83Vt*Z0at9=(3%6es5YeI=BgPKTVYaHYi$wW~Jgg`9}utaPivzOV6S=2sdAm zu%tSsw}0=vE|64cIT`VR(@|Gvsc9kd(RB0ApAnZASb`7%XDqF$+4@|gJ4En-;j-eH zTCk^zOz7LaR)b4U4H7Ehn>TLsc~z>E7^o|PrBydfSf&5(bLx~C-9RBhbn(#-(xZZ= z1Rd0;aHC}_7vIcg({kc+Fn6?tWu{FFQm}cu?98_O+?%fj;The;K+Bww`oX=en?YG{ z$92M-;f}BQH!%)L|M_?553Gw^oc=2Yv8!_@80$Kl-v-Ych7rtW!Bx; zXVUUFUhz=8pr?~;*@rFDA6>;R=n-!7TgCGxqOv+u&~xC}K)AcRtCktHzY5xa?Bvs~ zUAP*rkvv(3LcUvFcM-1P3gBJc&!Na)C735RT*1)L56TYg z^J$2hi_uyiODvhrE$K1*92jG!6>k^jBVpuTQL|PSGS8%RVh^gI+K><|kUaHjtbi{a zF}O#KQ9asq9MoZvO>0`y{OF{c5S)85<^;Bfl13-^^u2o7sm3j#-!i-hr>9%!L_m-E zAvP8m7{buan~3}Fn8Q!m*w||7>L!HYxr7Jsp`^~yDugWFP*)6jG;JZqyEnS|;75FP z=LaS4g1>UpBy{MpOepfsoD-hA0ReqIn}6ybsdp!!kS@paS*nZ5XuM#Ff9>`Zbd|s% zRSh)vxYfOkiL^J&^sXz|c2 zj%4?DX2!hk)`8cP7d*+vy7y@YO|;7ucPnr(%g3KIk4jx1!Zq31nzNC2%7ch*NB#%_ zQ%;TE{hppD?_?Q(H3vE55R}o2Q1lbIF)p(LTjblT+rE}h%(^ERS6G-;gB{xG@11;Vbj0m!>AM{H@_dHy|;un?S5HHrvtzYj6p$ISEbY=|&dY&~5 zuL_M@GRZ6SEJ--N+4q@R8^Qh$P_EasePPj4*9O76rK3f6WYvX<&3P2k5+rk9v8DTb z{_mF{IhVZIi)79aEWsAK? z474;oFX1)r$q>H+(mhYC_QGDage;zYR{PX+SPZ z-kfx+*%~ijul6e{%e|MxQCz^5aN@oz9V!uxk(S$euDHKnKVWo}x>}wS9}EioYdysO z`%0aFeB6cs;@XJv-{;dizoM}&9iL-v?ItE0*zeLBpkwiSwL4kz{@l4m(Kg~z5B;6% ztLw-~448e-f&}|Odw+A8C&o9UQGsFcuTWuinL4~Uiz=~17M`M#SSq3DRRn=k4Yf*0 zM{A%ku787(tqcICKMRYCCO&tGjqL4dG_KV&>fPvwYe%zQYY3Or{^5gp&Aw4r>;O4& z&*egNqv^)&Xs%7h%!$o!U+CLZ1Rp$S?r4haxEVd>b#UTP5U=jFSveLTONt{iO+t$R z{iA-=t?62g{Aer9B64Tvf2H%Il;VXtO(z6v7j=Z8wIqza=NokUt2XFZ`1g1x3D-zE9kkm(B?(VD$=GWHH2-r&>wSWHO+hF`F|Mx>_Gi)&?Q3H8mqa+knZ|hro zQ!}dtZ@H)~%4_5<5dqd`+Oq1bq#jCs2oPCg(qV3jpV0m-;%U0O{GwQMZLTmvM(^cc zT>WBBr!_G?5{B%hAVc2{VF95+h5fM(xAln;W7teU;@NVL;221z4$KG)yB)%%R z5p?Gj8SJvpL>_qF;XuFKiHmBLfcsSS=4`Wi00Aa{4A&Y{h>;Bc4P2>apf)`Dq@Jtz zpFwHgQPyihKD8>FamM#u6$8D!DiL8}r-DL4ryoFvx&#MG`Y@1c``}eva0Rz>3O`_7 zt=K>_+45oZ2u?S1aAJZ|_-VSzHl5-9wpIec6B(1!g2ZGrCP@Qn>^M;mym&H!Wk+e* z=VUKV_KSHmG#>8tL0k$L&9FYaE;dXO*BX1sQ^Ia$d2?pBx;r4J;o_$8zA^ubeO}70 zF-GN6kCw9!&t8>CQ;!Ctehv4`X8&b1v|}X!X9HOjLExu1aCvdOfJ@F@(G*jO@#rXn zlve9O-Tdw!T4e^&2T9Er9Wo<(pLgjVNeN)n#fgfFqFuj7SOj+^kg;FkM8gK4gHjKW zp^s5fQNF}+Yf8iJ_ZlP@q{qaoH^Ep5{AWiT65&Y z^8^xg-8-$JaFP4R`G+z4I4!nxw6xlJAX{bz(bnGH=zw7XqEdwS<;aIuO#0#O?I#8d z0<(E9DD`)L@5|cT%7l(lT7F9j6dF2s)6^%1iv@7_o8Ge*6&7gC9W=f@C%X&2hTptB zd_kC$0B>1rvYAdw>%>IzwOL}K`dT2-3X5`b#SU~UhH%wZ7p_Is1;CiCm3WJu1c6i5 zuXvMuj*gFK1i^8w9cZ3ZCj)Xcm5rd?xAg;g+2fU~Z+|Uc04{dpC75>`S6!6l=5Ymp zfsWSkE=f4i+mbK&`Fwd*6^CL~r7LY=GgUV=pK(G>KZcqP@+PM`QQMg^X(?7EKiCZ8G`a(o+3e*9?$B&!7 zU=)I4>JoC6*74YqFth{m7I7z?jRsLHG*g!(&LQDA%J7?CuI8_ zK=FTLh=mnWTUJ)K;(K-BmJb@eTCj*3=Y@4+JLLXh0Gu;5IyqS{a4w{54NX2z{3hUB zJzyMiYCB?Ix;@k6r78RA&e6L>b$E~h>D&CHAYbzwe;_uByU0hEZ+5h#zzDJhm!VE| z%i{#m+hfPruw=qs6LEKMFL~o~t!O46*d<5FblNXb@5uA1kAFgwOdDZr8aRo8xGS6BGvSHgu7Z`H`mqK{M#@JU7(nny(%*}ho zj0*Ialc@x6Th-KlO=_f6Cd^1ZS%Ru@)JL2lbcjg zt#LznYhnfh*ssOOiqiT1!&;p;dOs0$TgXO40!F2TuDfOiRIKm z<@UV=b&UpQZc@oJ6-7pif5jDPBD0XcD$3VLATfP#M4Z2J&isx->Iv72>KAqPSC=iQ z(0IsG*ay#s#{K}-Gbep;Kjg<^>8Q;65A$4<5GQM_kTrCk_*Umv*(f%K_qf(o5pg&4 zS=H)>2ce|Piu5kSw2qjCM$8=E=ybT~7j^KTeM8@iL%GjB(;((eU4g1Aha_%-UtfUs z?A~1}s)=0qpEtn67kWfT*Rl>R7{Tc1sFM^5B?9E{vfm>kE-wL}nTA?zZ0iSY!14wp zyjptno{v{rfZ4)!rAN6OrEV~ewSk5U4NoOzmrDCr;v;WXjaw<}gw#`)Tksc8qJy?y z;(v8Y6zbIDrEwX6Hf&P{kB5BT$=`b;J2bvCumJj0<~ zcEe(sZfa^RiN1x6#n0-As2Ol|Ql*pbz7AGz^0_bwe|rF)Rq%vGrhId)dG2Fg8uL9r z3?CUQtc9EHUT_)n*R~j2%=rcLNl1TN0cAzf%|EjF?cfccI3U2^zs~1iKrW-MuC5n?LiZt7Fficb z$Au|Ko9ly(8yC0Mr{QMc-Cq2HrgY?{k~DKl!{FStX$NE(|F$2W7h-+*(Z6Elj^(gjMG_cQP*%ceJVC!JciFUh2^1tvh&sQB$8P^7Am zp%_p9{o4aISQ8%xo7Zj^3>JDtvuky|!ffw3nzkuOG)bj*$2@W@O&FOM>g_@t9D988 zUyrckg1kAv;u^YSnV1PBX1F}?0+=(y;>-(#4#m-V2wExcS zxDjGHHQ_$6up z>N)bgmnak}9e470eJt8|x`X|m_?D>bdzZ3Yr_VRA5>8Y}q)mjddRv3Ha+p4_mRXM_ z^5n$#)-r_Pz=^j4CmuY6zku9}Rsj9lmz7a2(SL7t+Zj8aY&Pcx-PyjEc3D)@;8FUd zfh=J92Tt0^mAy2ho7c-U$>`p0iSEsM-j|bfDm^dQ?23O!+1hju{43?ZTyD+^Fl^lK zeM|uo({|XuUk(!FZA3|C_#TZ{TJc*K^AwD~w%j*()!QR&kxW8|lM`6{uP4ne1sSeGbV#{g9MlSp0*tmK(gcP{sL*<_X&0<=ULB+Zna|(rATS?j z1CkeJXC3a-)3;_p)UngGE4+w^2sxNcn{~5*9l!`|#s1{R-$3h5QGwYb?hfp*8`=%FG!0RZR^K~QwL+$J29K^}VN&M>A@z7_5u&@k9^PFdGm8_;I z-`FFxi&$}L5>e*;#sbMP%uXtb!{yFVeyNFd$toe^Cd^`jda{Of+;(Y43`g(8qgrPT zzj}|0-^8bG$bx=G3<2wiWpMKFUB!wAbtaGvOrYGDF83v!4b{&2xgLJoV*1Hn%EGHL zs41MdXVX8aZ$Ra4PGCbT)#c@=*{`S?#gg-l75(pT$n})wLE4 zU{w+}Q!zSe^yj0yx8a1jb?*w!N=?fa|5`Ljw9kv?`J@(BzX;pEvvBx3bIX@Y@u(e= zaiDVhb=2ne+euC+ z(5!H?GpZ_Q>YLIDo8fBtYg`ty&qQbu)kNjn8@0mxR<^eVJQpRljXPu^x2$U=#r_+b z>O4cl#&9`|)_R+ux_t0zGH=6(-if^e8%~fUq?!!CU-#-K7t7~FrrsARr2@uH@J4sY=bzSQ8c*1e6XhR zC|&?sE;9n0^Hc5-5gApPqi1d*S*f|i0f6D;jq`L6z2EQB86zo$=5ulQ%#;>j{Ze;s zdfHkYSS_eTC?g07qur`(|4jH?ZHeacDUYc>V{8ieT=S57M9-1iP<@$0P4hQ-ceE{9 zelZ`-!$BL%C2L1l)2$RCzb|^PgF1C;^%NB*{z$7EEi5&5PR?&dI&A6T(+i!D6IhZM zd;VbiFyBtl^rH0h%DKn>XB@hD7>G_##W!}EXt}uw%+1ZSvp?>+tp8qGce?a3)_Yt@ z;v&BNjxRagV^J~oQCmpf(EU8~uWrLOc&{8a9ZL?jdjHf{HOa3C0Sd$XG(C0y3^=rR zfP_;q3TALc6XWBR;EL>00ug~Oa9M>YC@3;usyMYucAWwgg(o%^4)Pty2D!4lg2Iya z0M3e6un>Q|ytO4}eR+N=B$NRs`A4X=zFywx>FEhK2`O(AQL1O0+h}s6b6iRWKK~(m z^I6V7RkcG&oby~mUjjKQRM7MuTv?(&JHLsEF7{n_#^;UUOva<+4TQPP9;*s^^ZK5c z7AfKMog<%iBKP`NCqc7u54a&s;$Dd(r%vE`Zn%*KYg5IqZN}ma+p@3aGWO;Hz1@Dy zfil7JVM0UlvWiqmY=tI_`JKaojImU=$`G-JKBEVF8;0<&rLbK6ZvE8 zvD@m`&(M^Mu{_N%f+%EPg%;IwO1Re7%Ju&G` zSbeuV&tw__UB3?Hj()X<8Rj&J%hVd@>Qv);8N|js0Lc_M;T)n;&Fyw~p?w^JX6RNk zwjY!w{#0>apI?yAr&(E6W=Tm&IX*NoF(J&#`d1GGU~ixgTrlUOir$<7A{G(7K=ld4 zzvsXs5BO}ZqmfbeDU5`X8X6i!*Uo*p(9}1)Ksx5bP3TGHkAM^La;b)#$KVNcae^*u z!y74dua>=S`We-cOroUGkmgIze~3X(|BY)Oc6C1J=QWl?%-}^<@b053YkDuw2^Q1- z6*Zbi3>E{u4#nOhiiEJZ*>2yBu<4h!|q({19W1YY|XBog1`TLtTc4l-yW=7Pk_2<(A(>F zF&9E}TgcP{{cy$;|7DG}5>{36x7=B>*QvoAaKkK|T-cnO7=7TxjHMl=a!g!7C@^4Z(HVz4C#Oai*UL`wd~T3)S=e^Iu{9sXr{n(iF99u6A~7hgEd0 zE41_@5m(H`S_<0Q@h`71U^e&I$$nu4mKh1ly-C(u)hcPn7u^4-?1M3#9??y&jZAFe zzmJQ1Vpg8}QonTU3VhBWHv?90-Ya2L@&z}BEwS5EcOHV}wUys>Cz=^U=y5f=m@cj@- z1%lKm~t54x0s(u3j;~sy(g7KK}xYfC$B?oX%^ih4S_uT0c_};CfLM z&Nul!;nwD6ndL2Tn)hYX^;{;Wfe|hn z&U+!t7jQg9LU3t46}X5MtHU^K1}VcOxTLH*yVu7tWUiM45d~vW35B+`Nw02h{%N%l zs2?fT(WnPWDjl74aZ1V^K*qD-Ldmn?g3F`1pDbk>zJ1&uU+FNycJWv*eIkzO*8j@B z_0+i()uBIzPL-APX@poQwL3hmG^feY(S!h7SR_{+t8I6E<2a$MZ4a5B0o4BX&%S|= z7?G5eN~=zluK%A4urO9qIdvTZveNpq(`MK>>Y%%Q`q-bsTKZh?{}YIHDNjx#I~O-^hw7c`%RE3+A2L-#=L? zE;E`XOY+|4pL4T(2L6Iy=HdLV%PqdHOgA@WMA%?n^7Zcf-WD?NDVTR71egsqs z3=;|Iq}7{v#B~1}lplSn7eia#=cq;+TTvw&1Cg@86JQE zzfcKKhEO7Zn0z=GE-<)WR3KhLPmL%B_w|Hvo6G#rN<@v*N)#SG{$@SQ#Y_N?ZPMm? zFa0~T-ll4^PELQVPJ8{D<<}I_5?efG=E}VGzSaBB{V~+@IW1Gl|9jnP&0sJ97l-i5qOmEvv8;>ZrHFWB zZPlw%q|j?^xW`Dkcx2bYyp#o%d`*o{{u9B?rf@}y%Zm>wx>Z{Pf>1Ajo;Ey)0OvfP5iZbc0Yr2SzGJ&5U-|ru?VLaUt_x8 zy^y6y<+Gp^>ye*nb*`tEphv60O00AyeX0VxZhQ)g5Bq)wrDIBID(04KpNDqc`dozX z!Qzc=uYP6ONZ1PJt)w!0dsE7aPWxX^cEwjd?GKh+r8!<2LBMXjBPmW032pdF3SdMG zficZAX~M3~Vs5?WS;z0lT$Sa#>GiENN%EYTPz%dUJ(Ozl5MN4158gkpIN#a>@|4@;GfrSztYPI>@K#_;yLfJ5!! zv-h_ORYlmw7i6D4i2ZLCf+ULePES%x*SEG@Wp(601c8?A{@LT=aEub>Lm+bBq6UBP z3$x#2{8ih(#Wp$*ahARdxO70R@T;+&}`!;@2;XiGhH&`#~(#X4;CSr;M z2&eY^0^8|z93AM$-{$}M26ZBUm)E&9JyEDt>KAK!lgvltO)6u)64tLTTN-5jNNC|M zVK>Ragz0ykWeL@mAu#mHars>mq}3X(rlQN`@sK_68O!aRP#g(de6TzB&^PUiV%I^5 ze*Mw2Nw+OQoc?NiLqJuF-W|rjqvBsHtopf?PDVj7Cdp&9>P*@ zOkPwX8|m%8hFI7Bk=Jj~e3=?CQM<1!bRICc;G;t2*_M#l#rpMmADBo6pVbW)vp)I6 z%-9!7DD^te{?|n1zisFdS+7}bI(5#4yraGnaEu^vah<$!Uo7D@);96WS007TC&h^R z^Wprg@Y0etSq$n{@1{oq@#(sA2B~uBy!a9j5_-t#1{MIp8UV;6p_grt1berU`A|R` zsVsv^f3%ym>Rj8_;rU9wcc(tFw&e6j!_OM$ zlaz?=akrWjOQPn}T0uEyQM>`Hp>#|#G&K=#RPK;-wV&g5)A4jt(T5B3Q=V~kIw9exXA{*iRX6r=jb8}+g$JLDhZE9adg@wl zO(Wlnaa4y-%JphA8YMW{H=gzOgIaYtG#WPM>;V@YnxFM3*>auAjJPd5_s^;pi+w&X zN6e4Yz9whlq#b&%6amF29>J=f6UrL}pM&#%pCc>=NZvGlT(BZJJNVfblECx);Cv}z zlK1J=S4qY|S;c^o$hDZmD>gAc{KiPKSh34N>j@I#?M-WTjf%FxR}8_&UF0;dW`tKu zXdXI8+w70_>&^|IzAckoJ#-d~s2Cn>>zHBV%q=eEgd0vxaec$xVA=?RmEHhwBq3(< z>#vp;I+M!{p#VFYZ@*XM7j4zHhg1f0Wo77onf1tOjBe_?xE<@@5+c$P(46vOo8PeH z^u_(k{?a8;DI2+R{P&ObhS%l<6WYny8EmYzOek4 z8!J6YAJ-)QZ=GvU29Fx}eSHQGF0xn1`ySjGEq<7GC^UBV_gLvb>v3fw*|Y_%OoMVSnajhrgV@n&r*Xe<^t@^`qCb1A!F}@Vimx)_DHS*^r1t#Q@XoDL_h>Yq)WPyK6HmjOA06mNEmdd zv>+1F4bqJu+`;#|{_)>o@7XhJRy?5%rp9&4FR({HO+I|o@9Xs1^E*7z<-_Yw#iO(JI)dF^;xOubyJr5%ndgRK<9%V5k$hK= za=MnlqyMg#f(rmdaod)Uz^C2w6c7|#{Dny*E#Wp=X1~}^om$9a^4>R6xJGNOM(hi{ zdX(h512{4`4C@+E@&hFZqVMZ+MzCZ;5<4P^5hM7NQ}|jHgVdf?^t#% zAh8Zkr6Jst?IRKOB)+dQOLpIy&V>G=L}coooS)*ykWo4@nx@*$FKnat^5q?0Zg}+eayteNa(i>jw$<_i8;f`6TE#0?`*!Yr_q zh9yFU2!`%<4k9mSgp$BgKF^fRZlx(E`4yum%6YPEOe@W&cafWPb?yWo6@%L;KYR&4 zTnPRSW8XTj{eEIPs$j&nGYbung_vY8`yM%uRxxrGA-W(H0* zxJ@6`jyd-PdbkhGtJBYKl>As1dip``q1o?je2bX@PQ@BVnk?hQ`59Sx1HpEc;l4!_ zRwZB4qVM1O*A0Y3YM&DU6-?{L_v>jiO%N|WnO>Z`>@j86 zo4Lk(^0s<{KJSOST-iQyWp+(AT8xsNd43>qG5u>gCH$OHVdu%k8gJY#c8)aSlZ=cR zx2hh&gVBeZmqI&p7?G7v75hRroYKxks%yg6o4J-d{ZMf3p>7oJJKG?i?L-J-Y#!sC z>|zxL{XG`z4sTx;BK4E}@Ub(?C`28iaM^-!{n-u7N*yGmR0&v2U&udvre!ajjn$fW z|IA~Gjty0QCQr&w@5}NNHsZwa?U3TWao|*!3QABUUH~i28_@sDdcHY+HNa6kP*IH; z6W>^K;qB_N?uLAxlSHA$ZZQ4pt-z*x_EEarON5maeshJ;x9{F{O)n}X1w9E~-D?he zviUqOSt%xgM#}XXBwp=J@Jiwb}L^|Jhbu2>tv)klU&t& zTUBH+z3!W5k*0+yiFq{=oI{lI(Uw5&7Cl&q5>54?nlSL^?J2R&moLylRy@=h1?I#M zXhdVQfno!HXQpxE6JCzQDNj-D^Hf(B-o3Go_~p?b-4{MPug;z3lx-Zt=V$ttpIS;8 z6U!yfY3kb|hgJy5SFQ|CnEC|PvtqFRl|OK9RJ!RadiJD0)#Pj|Juk@TFnJ;I&JoD! z&e{q^3)BQcRYzql;h&|OBJke(+Q9?{cP`V9xcK?`8zsxy8Y_SX1)uqtuD^TT-3^Yq}2zD z)poKMY8TcJm&t8XNzC+^6z48MVq7ornzuf#e?*E3kIWNsMuf83O2QvJ*e)5VUkhM9?eQD9W zc)&-*`LO3B0i%i&iG0SLB5Eh-Gj7g&DWg>N$&QMOD)+e8Ytv|fR4QUN=Dk=?)uVx) zcTV4a0V8-DihkObf{M{hb6?uc*#;}J@Mg4`v@SKWd6K(QLN8c&5AKDfX;k}z-{CAw zPa*#S*_6!M$d)d@eXr(|f+r8_d{8yfL#=UhpA}q^jg}HoT`zsRkH~^77`U=v+`l_* z3YQkm>fkq%e^t2%qSW^g1pbe%ztl-z1yCk=;eWkOn|QbrJh^+Mu(F*$Ez{+NoJ_Rz zhvdQg>e+kNMNd(6oZ_|VXg^;-Ge06$AGoY+zn-^o0c-I!@CBgo^S-HWb{hTi+p|*vU#P)nF@;UHkOAN-tQHN!Lb z<1!wy6ivHr1sVfM;x6U!7qA>94@;(Emn*lbxQ3Sx75|_mQ4%um=nSoQpqDXv6%RPk z^1e)30D*jyIjj$0Ifwy+%nI1|X=L&%;bxPC9USl`(YeSTIP`u*&o;tsZNd*-2<7?H zR>X{7NzeOB4%3D=T;AnqW%v4z5L_r+$!GIP}MP@L)z5m&i*icfcopVlXT=9P(0pzVqR(N^QNgeQN;3K|$v^{!^Ua*)wS56zvwV2=ALK(!$G~f&3)H(secNn z^$;@8o67Djt$?7h-h3o6QHTM?*QNma*>pbdheIi-ikm_fH#IfI)jPUusJ<#d z!hp^=NQ=RJPp;Lq%2_5GGq5gy^abh2jVm_F7(W+H#e7mKza{RRxPl>9`LNyhH|Vns z5C-z%(1+1-7KigMq8DPEJTr3Xnn_f+Wg>GXOuWm;R1HW&Cc%?s?H>oyb_F?0cCZ?Z zmO|nzVR%<%pB(wyTe_<*9Uq*3#IJ4dn8SA+{4}BN{s*LFZ7s;7A5!*AK$;s5P6Jl61#3|g_u$H!qGh(U%E9c9iV_{K#DElvykVgWR zX%KYBb-lx8f+6KFvQ0YIQ^G2j_Kqx(PI+pbkV1JK4YG>YnkL*{6MBWRm&wFz`pL*^ z>V4N%53qX8!$+SzGZW4PaYgmhn%NfoWQR<0aQZ!5EJR^bP%tOq#E*RzH-6DcHLU3# z)%|6su-C+t(E@rM8A()o4pyT2AI#T|%B>+${Kt3vND7O`5ac%96M*R}7*nYIV zlv8^&Lgy{H_*6v>)nyW&8bPL!1m1kKqA5!D7E-insDpnu|x9#v`ky&jaNeM)RX21UWGnF#jZAxa&nJS4J*> zP3uOJ@Io1>PTO^e={%WOOv?R&Po$U~z86Xxc*CyEYlAF!6o$0YK5#FY78aVJ0jG5) zpuc}V@xDR20Rx57fSlaDC|HQZH!;eD68i&BT6h9J8J~5bl93geM@%_uOZv$kDoS@+Nxp#Qj8rk04*`g635K?1L6HUCPy5tOfCRQXzS4_?^s~-48St&mp7s}b>4o@vt#Upgjx-N<<GW7 zf$Weh{f*z*u2n}Erq~9~X!%nCA-M5NrrUuV2L9h2u8U*_$M^kzp!hll<3{5*@e%n~ z$`9!m7z<6g9q#|e)$khqEZoObM~)c9v>d99{v5n4(wP)LvwHC}Eu~acl@k+pA##~< z>0=WQf0p;B*=c;t$R6kU+K3d>xbTzZ(M2gX;h)J3mg*=A?xt@t*L2@3X)YEf>Z{ke z!mYU@XffJE7TUTlgGkvaDBz3u1`6@wrbb7$e&WQ4NAEf~v#f%?*X#To%!E55Kff+4 zWSa@aVn=bx4vm-CtNfT7j~DA$p4)B!uV+#{izfo-2IMjYeciyhg8~3C04o7s`odHd zz)5L8O~J zu2_Dnt>N@H+M_JNt!y|09v8a}goK0y8hBzV{%pp0f)6__`~Q3TQGMe|GQWr`~1-&Sp8Tt@zwu zONUQgmV)N}eO(#3!F*Cg7KW4zoni5si50_GtoF|c?s*7EveWZzrrK3b^)P1!IP5Cf z78`z9!6I|T1pJ^rT)?6=z4o8}cb60!&tFSQCn%9A= z0*^ZS4_z^(&=*ER^He%S0%#4wv^q+^xOhQ=ztR7m0pnY)Qke#$;aY-{Gs-wxTto4} zH_<6D?Hf-VDf@%tn?wEy_r#Zf+gE9*7i%aC3qd^Uc^_k$f(|Ez5tCCE|R z9*XgmKQ0(;k+}96I}+(c(QI1W|Md%tj-EX5n$-9?ZfMW5cP|^7ZhdulxfWoBKz@#Z z*MnNPy<%q`h^qe+kA_FnT6<(&^M|W_2t853X1S=Wtv- zmFsDD{-pj%t4B9^;Aup)&RYKyBdX^dtV~Qvgs)}Y-1ybLv6Bl3@Yx8>O$y@L+uH+% z-Zy9G$iml!){5Q|Y+RdeSWLuan;#}#7H1V$eqV0M(rgq1j^g*gj5bz2Y85-(Kllpm z3~(|EfjP8TZ#K6yF%J)5nK9GTBdJj$``zes6IrH>{}v;f4zjU;YG!j zg}<^cTTlZSn_*#c5foUY;fC=A4`fPA@P2B9%Oo(InBJey2=J0eO|)Z?;XT|q<*RwN zn>&m8jj^qnJLOZzFT(jt7;pRVt;K%JihaYa45C$fV{eE4RbR5&&Xk|hvoik|v14h3 zc0`5D#7`QPUl0_A&ODbfjL~yUoe5Kn(wO#}o%I~vIPZN}{=x2^`rg&F3T+>C{ds`& z`TTK1-j@mgxyboF30VJ`81LSt?f-S=DE>FZseBd zcpmn+I4>uuqysMqR8<8l8=lNz+b&>`i~NvWwV&I*3Ps0QT*SlKMB^P&m@g-9i#t(t<+Up&oLesAly1`O@#-*fKIQpk0sM-rg=2SN#&|llDV@KayMTo<}0l4D2vq zphi5G%Ju8SpobQ>wxWN#PSPKm^NRlceS?1=WyccHzMjasNQFp28O%fad`;kDj!0d< z8F=K6q%jF7b0|b)kW}R?E}iB?F!~Ubi>Ww_B>fzHv%R3CT_fPV#n$cVEAi$FhDuh% z+^ui8*bZ?Q)Y^l>bM+?jd4&{8*eRM8!wBC8|^f0SE)eO0{h_wt*B z1>y^}sf}k4RPs{x9ii!f`C{>~tc6J1&-Fd4Y?Rs&Xg?BVd>$iW1Tx-4nPoGn?;pBX zVnW*&hpsn>lJHz0Qk-Bt`b-!~@eF?Q>~Qpjlm^sgZh9-e*k>i%4TV!8kVi{y=biR% zC8OL_N97CdAkJz$vhpxAxIA!2iUf!ObD(J<4S=(GUZ4@D{FV**)v(W$LV^?MeehfA@#Pm3#Cep#}`5{9?16hVN z`oUKeC*`@nVkr5GZQfXNfiAv# zbSz-)xNQy&4-3fX?zVTe12)e1US3){8|5$O_( zJ5b50tQtX5vgN#K)pe|&3nKPuQm>_19|@$Mk-i#Wa6rIJXNT`n-c+lAYr1E2ye5qA z17>8xnTUlOd{Oh3TNx>B8|cKU?cZw`ttuT6G*(j?<*A;YR6ci)~FrCQZBqW{-MaMGPwvvU7IYdX^LeBF>?c{U}D7Rj4 z&F->}GoJe@m)|b)o*NVBq(E+C!R057v1kJ{b&g6?B?gyU+8YZb=YIPK?2Wzt#`yDl z+LK>=<9?UiGW4+xpy*k1B&GR^*!JBNd37*u-<0$gAbjMn#ybi^!yKjze%)E;y??7u zN5ASin&nfZj)jARx?v;?uyr>;x+%vCpg&u)Jv3FHzzGT6)RvP(#|}KKk*=GGEPXD& z)qS|OoKBVwgAQ_!?Ym!v<+b0+zFDA zx$~WAfjuDGHT2nVm$CBEQm8J;)2B~O^m$YF?y~?jg)lvlj9v(>O3BGY}aRbFLD{uZ+;- zTpS!7C}v?}7^ON#$Jl}J;@?tYOcW@&qsE(E$#ag6mC6rV(%j^&G|5oOwODvAZP<>pQ#{asY_9RUw^-JhmWf_=2L!j z=eyTkgqVstOUA80sgYY41DB^E!)<4Hq60(}_HXl7XQcrzN%Q^qi(j?Qtu^4cI}N`& zh_wRBwh3V6j81`yMB)QwDF?7d+iW8@RTQ+Pf%&*06~WQF+KaQAmqYQTtBU{q>L~&q z%M0!z(qyLQ5?~p2moYbjnLi68dgm9A2WH3t7<9XUO`yxB!wmEiZ}N25{YHvp${=Ip zfJwz%RLo1bfn;0wXAm`M|NG4Vj#nIxz+MVM035ilogn2%Qc_ab(E$gs*AgU- zs*0444d;@OuR~WLIx(@#7=?d3_ZcADwu#vQ_lTi*Wk!%nJQC=M(Jwau>-EGKm=YsF zz?MXcMQtmYAiezsIcX^qVZUjcSl?Q=SU~}gG3p(7jsxf4YXP3(M<0MYF;p((TgmaB zuSbKHmX>tM&G~>O#X)pvC@#(v3T1@SO+{m82Masx2@e zQ*h@F85tS*auCO?0Q1W;9`Isnz!g3e2pcYCrKgX0qFmh!^BV}lVy_>QII46xzN-@F zsef|b(nmfp{nhavN#ws^@f8UL9pRo37Z>*~gznDiv{j%-9e^8^y6H(Rz;p>h046sL zkx#j0+Y`ft^y}ZS4l@LjO@WrxhR5#AF(Cxpc#_orEmI$0E$Ffe2z)BlD~rd+#%_c` zfZ)RB@KNc?R3>W+s}0aoc%W0^^}K>n|E~r%eY=>qcG-j!aOnc;xXs#=Q3uS2IPj`Pu}QfgsOitPeJ@ik6NT$h z?nG4yS(xN~_h+xPkf{^oEuJI;tliWD2m}IM4*Y-L4n#qFU7)BUEhBTg3P4AXP-GKn zq)K?Z?!?>epP1&imd90~qpT3i^erUPA~2(kteR;7+SsY}Y{vdqDSsFoi>_-q0QiSN z2vFDjgchFyM0*$DO3oMc!ylXhT2G;7jyNBH)?Bu?ovSH#@!@HL^|G)qUF4NZe5~=Y z!BD5txR0jCU>?xvN=5(uU=8r%!O3=~OatlySb0*N6<=DHU_T|Gg*}`Z*O%*hy@9 zG>ii$+E%1HXjdt3*D~-^^dkdmOP-GtdFrDix6$Ymi{HkRyF@>oz8(JcIdJJiVxr9w zApe#8@7V%C*nj}g=j#uE?ac-KRdpOp%z`ETFsN@}0H_e|&j%E1pMEJ_}nKb;m zdNqVQg_3HRF6p+qnFCb;#`}NIN+U7ZWqH)X4^TKxI3-4`n)~{sq9Ff{T~; zKp(1mdB{MLWgyAQ$_ljsdYtgpAM{zaPPhASGr*5C&i%Tgul=KabX0!&3^V}F9)t6A zo0hFEn;QX0m?U@foP8T1yB`qbGJLPAr^ojiNOYNNXyAM{o+Cu6Jq3NX*eXKI}j0sd=pE!&$Eb!lh0J2vPUP{#v;9g5wosO$Awan;KJHe6}+ zx@vozf1IqU9Tg7|0=o>25vFH|{au|YHbwfr>GbC)PvP6)B~Z)S&NT>;MBg1xNxwS* zWA?}IAV}PM4`;Z37eEev0pV7|LT+})?CcB!Mm~BulFgOhj6|rtAtA`68qd(x2;0Tz zV8}qxSNLPJC4XkQpooab^yGLW8(W=Mi%x|&FeTg122AO0{vJXkI!?~AFM4I3rw0cY z8in6S4>;xbwE4*F0HpcNqa1OurJZSJBuX4pWFvO}BpKdHf3!{4~Gu8)56g z3>1jXA1=>^xbrcLzehkyiVkJ)TVaWA=+Oq8Xy?&-?Uzzhk^fNCH(XDD^QP>xyXTo+ zqjD zUQJS-ToD-w(UPB~xy^oS)PP)JB?s35u)de8AiKuj^`!4g4mh3AH;p3!36JSvU_6Qwpt8k`PmpSgNCu zTR`NZ>2#Tj{AeETE&%tXV?-M?0jmchh!>c74gu{0-s@gk{i{;Guy0EyG}5B7 z^j*saiWGrX!U?R!qr(A#zh~>mC4vu67WPl-w z9D1e(dc7fEKYo&|1fd1c9!d;@xsOtkLoSzeKp>+twH+G>edUkt{hWyV}TR} zuGX9}WfU6;=XIR{vUx{&t>oO!a5^IeXKwDeB(00Cq{c4w;00&Y$CMNUU8>hk4}kDOaxu%)d}L`Cq>|Wz zos+%uKsk}-AsPe7Eh$5kXa)ei>^rbFb{U@jgL^LvMi@qwn85% zr^n5duQiqfI?HkuH(%I2@^{pGwRYu8h&@=QXi}_D&TbG83)km`G#Gl& z+HU!z$WEWO40IW~L8;3J$XBm-XS}Ypw5}5fxf*QPNK60ReO~lQGrmvN1A}|hD--7^ z$k)kt&Pm_~(|&cA6Zee^fCmFIUbMXlwBFQbXTR)QZuhPzIApvR*7xz2zW92D_0Oke zdic5w=anuVR?#8jfn8~-F4pu+$ef!Mf64gyvnLV(XXhfU@p)AqHz8=aEq}H-@8pC% z7NeCiMVx6MQ*a^18V8(yQKZ(BO=QG@D#>G%KG~SP zcmaRpzo6yg3$DoEaBQ;W%|na(d6f%QZVSPG6$DQK(QBBzUFyw*4MdlzaeL`f*87N_ zZ6BA<*=ciglnADs~L)Cgc9WOlT1C=zCz`tXo{B=;bB5Q8Go|Y>E69VclMGXHPV4JP6Vql6b z9eA@wmd+#W|J80`1OvTf`%nJg&%DMJUJqF^H5QXk{81Az++h}r*$RT>X1m*6S$IL= zSFMCGb-%vlcm*Br_RrWAA=%oBXEu6|DGRJ#HCiXiEKT=3tAymRd~?N4E^^SG?(y#?A* z9|ADW@JD}CM1OrezwTu`k*Q|$ay`;WN)v{p)nZvGWPhUkh~~hK&8eu^L;PT+C6RHm z!v13Gecm$Yz7(U&aVd9?{QzM%PtbnG?PLERSPWnI;ZgYK7dpNZ(X=G{^U6$aIlS>= z_3zeOPnK`rfxBv%7aGhKd)@zER*(S1hpvZP$j9Gl2E14ZMnPGXqp_9nWUD>qjZE}= zw3ufTm-*uN%{M9WA zaSt}pjgF*R^mFl`o9kJ^dlWMdect@?(X(L*n82hxFG@Osn}>}3j0ta=j&1ykFZW|w zfCoSDxI*NgwRfG*F^dqMIRT*TBLLF6t+)66NrebT4 zgSF@T@m|d)B0k2qXr}XVuiy{(ton&TmV^SNZT@o8<)8hIzbEk)QZQ?yIDQZz-{(#x z-D1gd8F_G`NBd&D;eo+iLwoeyML1-D`7iE}P*7kFi+v6H@?{)Ydr1!ug=m-gVe~Lp zZ$~CdP;@nkr&;nB`2Lk89c^TEN?)D4Ic*#1ba!)~d;cge;o{<@9aoq6UEBiQx{f>J z$zN^3&O;6}y1~deX6V`VpZH0AS~?<0-(+YDV;j$p9j*_Fw|;V2YFY(!W3YrF|N9)d zG4bahbbhB3;qk6+H;#X2R_P{3AIYRnN+7+5O;3oiL50NgWod7hl3q;6v(4}E0`5vS zCtz@vw!>rHE)LB8ImGJ&tjlUBh63y~MABqQfya+FS9IjFX zn*G$1Z20_Djbeue*@6HBqho9RVPlx%bPYQmbaZ^Yw7IF;{on1B2x>FYjhe0Tcc&U7 zLo_c)Hp3BQzj$BI+a7))z*Po$?ts6zh)Ty!-zB(k)UUJvVes&699?-um6W{|CDx zvNkv!CbE(h79+!JhV@Ra3ePB(M~(OV{vCopz^|uWEWOvL`RAe0$r|3on~7kRPridi0tOxzbs}M^ zECgOO6PeB%q->Tw4J!E5dp%<5psP3V0}-VZkpu+7V&FA{BO+D$bH4A22;(fe4f^*l zf9AxT(uU(7Yl)&0)JxJ9X0VwAzZ-gv=i`Tl4`|EZtRT>52nXX@lDNAX^;!h9omM<{ z`d*Quu~2Vc^P~tAT)zo2zmeUbN@i<+|D4EacRzTnV>y?$(r7xDLxC%`u~A}dY^;r( zbGjv<7a!@y^ACtZOdtxC!&mB1QNojM1^ppqqm9d#p<=pMn9fbpryDb0vYLQ?SIZlc zrOxT;Of2Ppf#}X{3I+P=Fu(Ks!({Uod=s}e$rR*AKdxNyd&uk9I(}AAx;yKUG4uYM zJ6e0^3*Fg6KMsyk`k-Bi4$%n;5`$VeVf)8c_f5c`ufHm4=7x_(^WL~LN`_@TivRXH zfyTQt5--w+0G*Gl_V^DT^_ymyiwXipu!zSgF~-lZfKxDt&N6qT?3tzWf_kNfd!7s!wOzU(G5(Q=JalJMAsL#9CUN!uBp zf@Z$lr+GSee&Z>PaWIXFt#RMuD4KOSXB?_UW&`|Yb7E|)`)qi-voE?tO!kd`mOk!% z2J*!sANzmLFb&xJ4vE0u`hHbyi1Yh(!Sj_zyghUj4@*c_2dF{59rlYlS#JL}wWY+Z1@C^4guR}q#{uQpw4Cp*JXb0cdrNCn^q zzdVGw9DYmzU3drUxYQvKHG!YV`{aKa#qG~`58psgW9!wtaAQfnS-kR>0%NTcyjEK&;HWo@@!kyF0b5k8%_oDU(lZV4kSF{fEE@K1Q_hkYaFIy)&g6CpJO!5 z3qBn!w-Vdz#uddaxVFp;>1$1-A!(+8v|_j=@dGm6^zt>G>TM=^eck&D^s<|B_#%MV z4Ds>C$osedJ7!1SUYk>{G!4=s2sN*e^+4w80_q> zK;I2QT6wc`MtwoiG2tHi8Pp&;OBW*uk<|R zl(eh!cAl62^sBhXDJ?QxJIcpM5ee;8D~txc>%fS)z47h;V*%o1F(axF`JA>BKLb1w zLAz&-UIDjOmBv!e0l)+vy3?xDIsBJ?e%b)X5_Mzt@(cLGmL%)#>}_vcwTqVY6NCBC z@2gc+EOlg5pd%B70Lr~lEQdm0=McEO!LC7vfM#3D&RpZ|`{A61hYsY+GK*{JbB~F? zzTzU|DImA6L;b!S+85g18763qIM+f*mq$#}H~nm#*S6>MITl%XX*0Y&WRhbR7Yzmk zJwU4aQGEQrh57}8tHtZ2B(29z6~TphtW4VFO^J_&>D@5LLZvve6?~_xvK5vI3S9y8|2jJ>=bsMKY%HWmL z*_0X^M)Bwn6CBq)}YTYa|nd?TmA&~sD5v<-W|*1<|$n0@_|QB#zT|2L%+DY)VX zU-Bh&z5oJ$d6H246 z79{gwVN403ip!)8RsI+j!ADFn0A*6j2@fY}6svM^BQTL~p4i}TXc^e&yVWR|=FB*5 zPnJzygJB+7$rFMjTQD(`H#Vlp&d!D)0s?_yw_%G&pu+oDXd}f*WQ8cAcj4tiW7lU= zyQV=Q@~)JFW+Iur=SUwubm8eqQ<$(NKK0FBE}rVp5bbbqjM3(qI&`SW*Sm*|@|!vn za7&Oa2FVEsg2CZ71w)`8CI7bFabZyFjdXQ2U%*P2d|xUSXdd1M!bmYRvgzA?Vh7AM zyYl^}4D9=cP-j7Dqvt2t7R4wiYsSSZQdy~8mhVGD3)%4>9p{D_+i{jy@kb>`nJZwv zb#q?U@1ffKB5tnQ%hB{6BT`C=uW$rUg(dhfRwq&43rMdQAAq0noZFGeha_V_=!G{uYK)6XZ(RDTX1M|M}C>;7`Mkoa0XlNtOCmN@27>c}-ST z6-I8s3=O*uS9KbFrRf_dryr}OZMWkA`r`tr!F|*bXL6qdKK=3+ z%yJmqH;L({tgq>_E-%=%DqA+5`uV*-MVCr&nyz6C=CcMmS;FQP7TS$oj&}dmKbIDQ zh86;$9?+u76(zIw@dCq^9T zt6oTn;JMBaPL*blzRTkA)vXLCRA9$jwURe=L;dAvmgKEq;LfdS)61Y%85*0)X(-|I zw)H(04k6x#l`Nrd)e{5y(Rtj7iD3j?=fpLW5%+NL;c#0*Py!$NFmuUn`O{qO#ITE( zGtIA(TG^SHP@%g%5J;pqTj&UBXj(-0%-)wJR$6;xo;g%*ZsxVYA(94HA!BO})bxGk zBmb~hF}?bS>No=rP+6=E-=3#&(&QmeNFYSC&x z@?n>epiPGgCgq!Oc?AW|kUli%<>lI>d8J8f!@GdU9!4;Qby!*L8fp4eBNK{%*uF=X z5%dEYj7po;r!Xe`o12(QDW<5=B|47_ECzE?70lzaSB!L3GZPWGezb`R372o5O{P1C zM?M9Om$8E*v863YF~D7KH?>^%gybVPPf2rSE!gkH=@Zq3#&m{9R9O0B(BiUr7# zrx^HD9bh_q2FVl}&hzR488P5?<(Ush0~fxVzpteOmS!DEr!HN(0dR;g`6wY2|q;Hg8LoNf2E zI>7U@tE&>HlVY%3?8Vz(qA8vz-whdwHSokBiDK&Q>9YOuxF@cOSS<7kCder1gYQw} z+L>H4E?(b@Y0s!v35Oq9g4g{$ya0w8vEY6)>r0~d?&#}@|79-X_-BldTdLYHHmzXj zv5rm_DKT-R%T|`N!{A6C4;#uNjADnrBXwYLB;_Ck`Qw^gHyVzYX;lQo$y>7TS6e61 ztB8$RoTPB5*yw?z7yo{S*|BJLdTd^K@W5iwZ)<1d)2_Ir6&(4@L> z9){$Zs9M|FmRxU7y!i)Wmq0Ps@a}+Z zTzgnr7LD(>s)&)2u8FR#rL(KVQydI`d)*sXU9JCv`qaf>Yk*1brdfF04fvW z`n}g9%>f~363-rPA5^*i0niBgbUte+P)=7jCH}juE;52G1`J`8cL^Ak9ageihsX!s zF+RL2EI)94>A_N_2rUtTQfC#~_O3_hQ*WOyQ|W~uYhu|SSApvXm1KL$@9kH^ga?=G zb;eoP;dG12uB1+O*atErJqMq>YqI~OUJ>!JJcW{k{*hXDL^F4@@nB8@8}bz4+k zX|RNT`65I`MYXiJ2xC=ISvQ<}NQ~+gu-5xKu=K?SXQg&0N=u+zPs-|#ut{UT$7f*d zeNX1vMQ#0Sg$W9D2DEP=Iw2tvAcj~~QA)Sg;Bj;!(vQm^;M9Rp6mwo5wq9x5`{cwR>JHwOzcs#N7r^T(l=pwd-~ zl1S)SzWm;ekDGlx8pfAV7iIKZ`fRQxg2<(ZA;i9Lfw*_6{-=Z6TDJ(8MKHnwjs;TCJnV+qgi)){{ zvTGPVFLqSyBR5UPsWW!Lo}ST|`j(o+mp@pfkYJ3BLQeQ#Z8RF4EdzR8qT+DFZJA=- zruPn^1E+JvG<;2S*~6a_^X`b*n?fTQ$rUZS?}v4}@y9TEIGs8}Oq?MxxhJoSY!5lP zMih^RvSBrpV;lB18Ia@#oBGoX-dfe(S6N7M%`PBSg85K|hlhKwXGoIE1Di&dm7e%J zx#cgUZ3v*z!@$p<9HR^?twH4owgOJDX`>$%{8GQ>!@}7qOl$h>kk{$8-df7P`v^_O z3bp zmY+{$rwst6W`dOUY%vj$Ek4Kqu7d$Ex4#d8f(zQ`dKO5vZh~B0mA}^pGB6wFCT81B!DFEGZNeu<|p4i_q%_f(r@AP)@3i~)^jZc zr{-#JgbL2_u{XC(nmR;7R!tcX%gN@gmkTd|ODe}65X#dGfLU7koh!oS$o-9MMxY$F zURK$X^%7{e;sI11Xh4hnuU~OXZV?V(kTy+5bFbV5qOskkiROrk)F(7q@aYBIC7H1^$Gy2TI%wzUw4_7`NH_R znS~dY+@h?vydU-4QdqIEs%&CsDMX&TMG>2c3?CC+kP@FvddW1%wpP*4EcQL>Y z`P*K+gYj-w`xiU-{;;x$_>It624r(Z=TQ-@-e;Wo(YrieOCOGaX+k3a&?WY3X>0d= zg+om%D=PuRK-I<7Rpf=X_S7cW@Hc>cy6_Uv>#Jg~lmv^N`Boni6v0glBqdpKMsijb z7Ia9i+Jh?BFkbd8eKC&aEXAH`da{{Y(7s3FH3d#Jq3=(@CQ_#1Wjhl6788W|ygR0B}B zcbtBk*8T5mQ&k;qFeSw@Q}J6{w2vZaXLX#8Gk;|`yLh(OS?*2^LBPuk0-W3W=b5>= zVpvOy7abtwV)^*^qyjBm+Bu+wwmv*O902xReL&`T4l3o&7q@>mTr&W*g5d3ob!xlZ zjOc#1+I?XhR9khWl*(4)B}Z05lBV3b_xQW=@Bp{VDd9!$$jHNFfVA{60PN}>05pq( ztU^pcFNyMZMhPnd(b@SFkF4Kg8@tM**2s)c3O~I-Htgd-OoN;JhkD4I3q4x{vH(Ark=D1aT_!d zfdp|2Qm*?s|1R)JG*(oMUISoyVhrPe02Epo!bWMoj~D{4QjHp(A-wIER(#dJzB@vkjyIGEZ&;ju3>ss`%`1rAO0VX5eweX0UDvfYCxA zf6jJOuYPh=1?K3e9m<_HV$rqE@k2>&IS8K0AGlw4GMny zGPMEf!a~;cx}qYUXjUEwdop!=yy|doZv~&Y_?owjjQXkQL2JPWA(vGLn8D3STZb30 zx1$vE=Ai>Bqo7GXb(n7=1~?Pl2D8he=(Rql%Z&+8e|Ja>&=Bqpoj$!s{*q!;m{i+# zKE8Q)4W46hZd=Au&=-4ib9(S%=CgT!)}b80GBNS-)d6ilPb?a~SJh(T;sK|hG>X3h zwg6m4U*8p-LWc%QwD2az1E4|l^nK&o)c5mvsDF3f(+S3d2r;HHCXs~)=kcxUI9OW57_=FjA;0nfE)z6mkijrxFYIDEx>2WTp0+$-$nz7nX!WV!HJTf zB*6r0o%2ycAk;hB8j46A3us#^mQ&#I`m{Ty>>Jj57MjMEJ@n#3dd#zy^IBVjyn`Pt zS0SJwVT0rzN@HJ6t7~YiY;XH4jT!lDBm;d$hprVCteu?rKR%xZ?|NCZR(7lXK!2x+ zg*y?6nJx8}n)$r}CI-5NiOI&xvS$$G%$`m@o|)1Y7IvKNA>FIbzLEF&&<(?|ah4+d zVK!$p9y^$Qf_6W58mp^`uYjG5U)?J2T~^k7aMQYjOaFYHWsFNcmXZlVG=#L#?+9!Q zRno2p%J{e-=wNQq8j3`=lLzeWP-qieR~YLG5t|I>zczCj1@=KZ^iddOS+;NHH^Bc%)`^DuN^u$hh{NXZ> zRRk)ff3H(Nu#5F$^9L)gI%>(l`CHshsZ)A-!UDK?p9^#wh-}^0rkpXu&`C@P#MYn5 z+`fGtbpTv&Go>*w$!-bpLev;3+3VKcapj~FStnIp|J<}+N!Z^S&9QeqTwXlwjY<9O z3t#xO3raqa`*nfMD4meZ0Eu*&2{C{sVL`ruwAfm?(BfdPTQ+)-+HgH!=7s#K)i6~Z z&i@&Vf?iDww7Z7o7}aKB2*J`9sl<q2%hV735@OYHRc&6Oz;V;G4> zCxfkf1ix`N+0UFb%}3MMJ7fWC2`O^Jz+vm`X0mMhv>_i+{*sZhV}Zsx6w=+( zGuCJ`XB8Op^X!?b{JuqF0he1u{YNG4ks;wogHKW}`s9))vyIAG1(R5lxPMH3o^IPg zPq_NRiH^Mp7$j(c1tcUGK$yK8=L@?k7Fs$2xL02Lc^K7bnQ{aS^8dmU_NS*7xnZ{# ztMogFOhxv0GRpFQlp)bIzcWqQA#LLszIX7V@k5Z1)6NGjLy-f(>~YBf_@hPN-G?G+ zf9s56kAp?Jznc_J-KIk^V$NH8VOqHArHL?tPANzKsqSkraJYbCP=#fxW{Vu@4`~y?pXbo? znt^l)2?iM2@vgt<+T>k;gYN;}xmbOaOD8>qqUHSBEV0q)Pvt4>O<*q3T3q3p;e>|L zy!li6%NT5xxw09akt~Ac#zT~AfDs| z23Mcv>E9Yei^NKwPhx=@0+V& z1ei;D(K}VzpZ`>aMG1#H^9-cjAut`GaMoBc@LWMmeiK~!-RQG5YS?29mcHP=9+zfA zVH}e=BqckT!_&yC^pAWhI&)1`G4n2#hZANes|cNo>dDd=#dMeo&2k8f>M^NOD^HBA z$}Q6Sxouza+5DNjaF(ZD5+j*9989kR>DSN@Il!IhR2PNN^G zyP{f+#9nUvKY1{FA5ZTdl@NuBO5aNCO4c)_)uEnRJ1#=#GYkhfP1O_)^#CzTzzjr< z`Zc*gIVQ?fsIl9CxELgvYxdX^$#+;td}sbl!n`;oXz*zmv1{^iI>S4yql;S+w4mqt zo!x`ztg{?$`1We&d;MJg?Yt~GzLKToJ0|;=pnU#_DTVFB3F1X(C*Kk~VT=|!8+pkw}3{RN=|3os^a<*;d(TD!D4@KfuSH76jx?nku$rP_{NAZq8_t|3Whk0 ze0$;W-FkR>^xjbfm*MMJYC+Ez7va$&eU#4?74xzQ!5Mtn?EV0ya|IY+s@J`#G@c+S zeok#D#B=+yWgu0*CE$b_UF)w+pkEeZ+3CG0_H7z zLR^k>X?l;B9CF@H{UF^E-(?)mM6NpCd^`!*VbcO%`uKW9Kvwy4vvAZQlj} zQsZpjod^85#4uYZdx$|C%F-54oML$)EvR|UkF2$uQ_xJUnM+=jE-rElx=xcgI81sz zjOE}31?SQ9TF_@u25Z4FXd^f8xT0I&XrRt%=Q;KO!LB@n`VXfvt#!Kh~Q23J~W_5d!b zS|95@C&5mnx&Pqj*|1KT4tx+k>M?BEl(=MNmVPk9T?2bax_N{bMEq__TW!$@X;OT!8 zw{ShEpX7Vk^gyHaiE0ccoD1ME&dWvlqwb3oT?zopy=)@x>AwUpH(R3+*6?C`-@X^M$mO{`(D(X6qRx>> zcIJEtGX~194uJJTfvX+6PG#n8`lKXrZd*^_kCvRJ#Qw zXTm*RD*qS_2p2KjjDJ~Xv2f{KduiFzvqkq@?DKUTj?+gLTc&ZqE#Aw6am6&86&qFh1?pGMjxTMWxRJuHh-{s?NH^v{2}!>0M;ODAcH`H|v9H z-zN+8gnMsWuNb3S0&A?#=>=>Qi*a0F$`Lgi^IrU~TH7rK)nisySGDJtnzgJz`#MH# z?hVAC^iVT)5qGr(0ZJ5pEi@$WM7K#GT+O0B3FM97x2blSx7db^1W2tJ-$ zFSJ@79Ay<`O9ju+QyIJ$wYK~k?aE(nf)AC91?(rBcTXFOx&5lO><&6Z(8mCpxLMR= z=LvvI&D7bDfKH(pIFUE2F&~$WWQ%72PbarIhenK4E)CZ&-&yo3&6FE4r&Y)#xQJzx ziAEe$H{CYBtxWIlO;zlkbS?q>3Q%nOmG_zjJWj3wTA$SKA-7P=xY#2!HfTd%A6G(j zw4NI?FE5cDp5!;aQca7Zfvb2BLH&L=%=|u$js4N6)!yc_lK)hxdBL%~zR7@V&9lYr z{NQ@KOxb$#rrF~F_f1rk*xQs3%{!3{4YVbiFm=`5sHnQ>zJxJa_@CWbAaiT>qfoIG z0NBNlh!e;}m9a5}+>;wSFsRsEAJhmL|9D-{bK!!tr+N~E1{=R7p{jmEMY0k@tFLYTdn=I0y-D@5}4+k#VH)P6> z{a8Pz>$RMZ`;l|U+aSJ>WKH5RGp812ecKS!AtLGG#%Ew=o*n`n8C190#AqcaP=rT7 zwB=R=Wn#xpawdh;y|o&{fkA>#?f#cPtfAWFx_RBGQyCRCFu60=$UUVmKlrZq;1Y3C z529K{SMP}U>CP6SjS&(uZ}~i@q-V;3W*-o}9m=!5KYaoPl3wf7XF#+67eHJWjQwqW)?%eka9_i_Wkjorr(^8B5Ki#jO)maX#$_`5$!IzBh&{8xOkdZP)Y3pC^P+aV; z7B=A&5~u4m3PM?yYyGq;jHvaPgGXqQfocE{JYcb41_eFr{aPj7vIZyaUYL>zA!x4&rWqK%x?H`g zIleLQ&JaAf&}6)Ka4_6D#~s+Z6>6>#!pC@(zjfU4y1doRVuLQj5OOdksr)eb9qXR5 zjez~d6neG8oB%)9zc3K^4II*)-Gy;7ajV@##Si>-d~R}Syf+mQ-ou4 ztCe$#NutXUM#Q$}nuI*!Uyj454v?f(37^?J+_`_B3>QX$k$mi7Vut@)Ay~G5d6zqH zi=>^<|M?T*#kV>uE26~&jn?&``!BPkC)(!RY1icg-vsHc9WcrAFOQm6jA z{$Ih385-*{zjc+%sgt{P8$ZOCu(O9ymT45Otjk!)Q|C{r&wqBN<{fg)f7qx_T(28rVBvU4N6?pRMp%87N8>Yk`3jbE}(af;e z^3aT3Gwg0fn@5ja^%@|Y3?}WV0Y1MG^LFjDGzrSD+PaH2&|pIAd`@bw zzlJ9^iWazs=}Z(WN&!0OJV3F4rH&9Jnvg4hDmrwz|_^GBp#n z9&r^GNgumh_+kv_;4JNjxJs*)k~Y2Rim7G%d2-?=lG!fhy3Y3=JG5X*P;6-L_4wel zn@~839TOXye4Nq~(!bB;)e0q1@c8yH-Yp~L5ICWMh z&5o;*6Fi%gYbU5XPZ&>&5lM0TAbd<)=G7uw>sctrt*<&**3_A`YMX+k1-)S|QULve zx-8>&-9hk((X2Ac0y{-Cda+EdZ*DZ5y3Qg@oWBr@w6`hdj~K(z>33TyyoD*R8FY`C zGzmiZ1PhCLj@GKr?1TuylY^DXvwi*98QT~Etp!ZpqYOZIC=~Cc*J?QKBuseCn4{kYJb*_I-^ym|m z?15}=6Tw;LT?k{dap0O^-S_ew-6;QvkdB2DEJ-ms^O0{>g{Ca5WHsjY?WyH6i!Bmb z4Ws=q*$(pe3qc4#?~)J}-zTM(0brKDhfBnXI@~8upT5n?qWXo$*pK(S6;nYHeF$jV zW36z@=4o;Bs1AtXF{p+=N|3r{ZeJTuGTkP9^#elx3s;36Jps$0Yq`4m)R@Pm*-8Fv zJksQ+8uk^1m;mIb1UigdMs{W1)Z2l_pL!RMqi|TrUWgN&5owk|tW`TdjG2r{IICc$ zMwt2Z=giy=a)9z@NL~L_8^BPMU%7H(l%Rj)Hb!VI)IcX!7wNSlo#flTFhaN=>QTnT z``s%OI!Yh@ov>4AZH{~WPx(nQPA2oihiev>#~W)CrT?A#R)aZKLyP z=P23&&KJlOy5g0|wlcQ!g?7GcOMp1>tWVIDY(%~D`7QekYyqU?(psC*fXCHl0_A9x znPtdCQuUcz)XNQ;uN#9AnScm<G7`rufs@a|I-kR&fSpToC9Bv zBgnY7{P?(h>>CbrgD#pbgxsS0DTc33CLg3)&}i?Fs!%sNLukc)HRGN=ft>xV8GaB- ze);&ZFw=*k#?SZ2K~a|oA1O#=uxF0@XJ)s{m`(Pb@LST1Y8Ugb{=vWzvFt@Ob}l_C zt3IRVF$oU%l^0pVL?<|>m1wtok3_KL0sZE&*phg3HtXEzf< zvy`>ZlmF#(C&CANh zwDRr4R7J+SK6|_pigk)LtfpD>XYa4GKdR{8Ycb#==(zJ=nNju`PRqwGLr8O(3MIO!w zBFUw7H$lB}fv4T)R&`F(yyPZ8{+m7i-|<%fR0mqM?WB(0^&j|4qjrB&b)Q-Gz)Y{e z?FFG{%e37+9DTqo+2(d9*zIaD{wrCu`_kqMgt&wHe-&)mBg?OcUr3%qzLn`LCBYXc_@`^S3VBDmM?{&f5noPv z1mYgB^6_0NR2hxk(3t%CmIw4__2T6Jy=z==3G)?|jd9&a8@*m@*3z z>YbA+-dJ)|`krOgcafABRZL}r!SpaDrMPb$HL4>9$s5u58lMX7!c(4`B5+7PL44|l zj(h0?Ddt=TN8rUek&_0cmD2lRu^%1CPMn+QEs%%*#yE8;02_mVdHdchE*X3L{&dw< zw!Kw4pOs#}3J>X!C#cXTMpQ8`W@Iyi=23ViA;YJ_N3*X}yfdy|HpE^3+2s$y zii(f70%Js5+J8^4cq`xq0%;rSV1Uw~|GiM=b0d76aZ^`HLx-3ByD zc5A(x6%=Rk^VQ!d^88oUXtyY>Wn)wX;f?lW@S7_JF~`_h0_UBH2SE0<2op6I136@R z4%jz=%hO4jWLaTo5_`0{uAJ3oqk$C}sbf!!Ni}q76fUWL%HvZt(?jg{TAHnv`C1<&tPp4K}Zas%zVu86olleSPTn~?H`t^PoDI$Kh&SEWeX$T7TYmVBZ5pi?fzz`FFRZFte~IDkyYPhVj0J zFCmvrG6V?gsYOn!{9K1=-QHkMjZ7i9&pM_VSN#lc=tgT5)*Sp&$UiD2lfnny7Fct> zJU>!{nB#*{nmTB~|MoaYKtc09{Vorsx^f;dXDvkLOJi%c*%>A3!n`=9TOiC$~3f7AxGFC6JVGViq-c;BjG$Nr<#Na((00`fBWuO(TB- zuJ>GG@@xT!i#2T6RmIKSMlsq@wqb@A|6X34O2S|0`U*aVgm*{8+~#xmSt#v(y8J@r z!|Qa-8|6nM4g$L_>t`YtYn@JHqW;P^$IUi~p6q<`u3oFO(JTg4U|HpRp!eAN3@sjt z(h&o*=#PmZTxGDCi<_GiP2wceL_%0H$ zCF$|vUw0381djHoO_Di2I;NO)e;iGYE*Oo`163{TgV~d9AC(W7>3q%3@02pl)4=nT z6A^AqqrfGx7$iYhtYBR!KEjf@c{{XcGwpnj=AQVaMXDpvt9<|@H!fs?0U*Q=C>&r( zflZnR)4z92FascQ2udr#93K$R>%mI!nE|*L#zEZU6m|GnhjX^86UCu!8zLMDp%@r#)#2fJ^h<-msrkE-P%S@Gz7=!QGhGzTUC&Ui@p4jH*Ff$`RH)yceo4s>S zi4#Hzvb)!pC}N2F?vx6}^Cy*f4o`rF+A$4?dwdYEM94R4^My3nO*<+A+Ly2C_{Rey z@GEycb4r-i$WK-*!axl_G|H=77{V_(&?Hr7TkY= zmH<=902Cerf4Pg`VDntl-sT=0WNUktg4jw?FH#~@R2F-??b+fYL`(WW{R61??V$n)szRv3q1z2w*Q_X6_E4gQrn!sPbGIBz-E9xmkqcw_ZW5w!4wT?_g~vi zm=D;F9p1=|?tlLWBJR8b=kh_(^-~@GTSNLWynVAku)tta8w_p0*v1TEzLzYh+ExlN zi~a1w=26-J&KfLv^wL-e}Byk{ Date: Mon, 29 Nov 2021 09:51:21 -0500 Subject: [PATCH 06/73] add infrastructure for residual term --- .../lateral/MOM_internal_tides.F90 | 79 +++++++++++++++++-- 1 file changed, 74 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index eb7d3a6340..39d5d4bfa1 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -65,6 +65,10 @@ module MOM_internal_tides !< identifies reflection cells where double reflection !! is possible (i.e. ridge cells) ! (could be in G control structure) + real, allocatable, dimension(:,:) :: trans + !< partial transmission coeff for each "coast cell" + real, allocatable, dimension(:,:) :: residual + !< residual of reflection and transmission coeff for each "coast cell" real, allocatable, dimension(:,:,:,:) :: cp !< horizontal phase speed [L T-1 ~> m s-1] real, allocatable, dimension(:,:,:,:,:) :: TKE_leak_loss @@ -79,6 +83,8 @@ module MOM_internal_tides !! the energy losses in [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_itidal_loss !< energy lost due to small-scale wave drag [R Z3 T-3 ~> W m-2] + real, allocatable, dimension(:,:,:,:,:) :: TKE_residual_loss + real, allocatable, dimension(:,:) :: tot_leak_loss !< Energy loss rates due to misc bakground processes, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_quad_loss !< Energy loss rates due to quadratic bottom drag, @@ -87,6 +93,8 @@ module MOM_internal_tides !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_Froude_loss !< Energy loss rates due to wave breaking, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] + real, allocatable, dimension(:,:) :: tot_residual_loss !< Energy loss rates due to wave breaking, + real, allocatable, dimension(:,:) :: tot_allprocesses_loss !< Energy loss rates due to all processes, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real :: q_itides !< fraction of local dissipation [nondim] @@ -107,6 +115,8 @@ module MOM_internal_tides !< If true, apply scattering due to small-scale roughness as a sink. logical :: apply_Froude_drag !< If true, apply wave breaking as a sink. + logical :: apply_residual_drag + !< If true, apply sink from residual term of reflection/transmission. real, allocatable :: En(:,:,:,:,:) !< The internal wave energy density as a function of (i,j,angle,frequency,mode) !! integrated within an angular and frequency band [R Z3 T-2 ~> J m-2] @@ -122,10 +132,11 @@ module MOM_internal_tides ! Diag handles relevant to all modes, frequencies, and angles integer :: id_tot_En = -1, id_TKE_itidal_input = -1, id_itide_drag = -1 integer :: id_refl_pref = -1, id_refl_ang = -1, id_land_mask = -1 + integer :: id_trans = -1, id_residual = -1 integer :: id_dx_Cv = -1, id_dy_Cu = -1 ! Diag handles considering: sums over all modes, frequencies, and angles integer :: id_tot_leak_loss = -1, id_tot_quad_loss = -1, id_tot_itidal_loss = -1 - integer :: id_tot_Froude_loss = -1, id_tot_allprocesses_loss = -1 + integer :: id_tot_Froude_loss = -1, id_tot_residual_loss = -1, id_tot_allprocesses_loss = -1 ! Diag handles considering: all modes & freqs; summed over angles integer, allocatable, dimension(:,:) :: & id_En_mode, & @@ -184,7 +195,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & flux_prec_y real, dimension(SZI_(G),SZJ_(G)) :: & tot_En, & ! energy summed over angles, modes, frequencies [R Z3 T-2 ~> J m-2] - tot_leak_loss, tot_quad_loss, tot_itidal_loss, tot_Froude_loss, tot_allprocesses_loss, & + tot_leak_loss, tot_quad_loss, tot_itidal_loss, tot_Froude_loss, tot_residual_loss, tot_allprocesses_loss, & ! energy loss rates summed over angle, freq, and mode [R Z3 T-3 ~> W m-2] htot, & ! The vertical sum of the layer thicknesses [H ~> m or kg m-2] drag_scale, & ! bottom drag scale [T-1 ~> s-1] @@ -502,6 +513,16 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & enddo ; enddo enddo ; enddo ; enddo + ! loss from residual of reflection/transmission coefficients + if (CS%apply_residual_drag) then + do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied + + CS%TKE_residual_loss(i,j,a,fr,m) = CS%En(i,j,a,fr,m) * CS%residual(i,j) * CS%decay_rate ! loss rate [R Z3 T-3 ~> W m-2] RD??? + CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + dt * CS%residual(i,j) * CS%decay_rate) ! implicit update + enddo ; enddo ; enddo ; enddo ; enddo + endif + + ! Check for energy conservation on computational domain.************************* do m=1,CS%NMode ; do fr=1,CS%Nfreq call sum_En(G,CS,CS%En(:,:,:,fr,m),'prop_int_tide') @@ -537,21 +558,25 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & tot_quad_loss(:,:) = 0.0 tot_itidal_loss(:,:) = 0.0 tot_Froude_loss(:,:) = 0.0 + tot_residual_loss(:,:) = 0.0 tot_allprocesses_loss(:,:) = 0.0 do m=1,CS%NMode ; do fr=1,CS%Nfreq ; do a=1,CS%nAngle ; do j=js,je ; do i=is,ie tot_leak_loss(i,j) = tot_leak_loss(i,j) + CS%TKE_leak_loss(i,j,a,fr,m) tot_quad_loss(i,j) = tot_quad_loss(i,j) + CS%TKE_quad_loss(i,j,a,fr,m) tot_itidal_loss(i,j) = tot_itidal_loss(i,j) + CS%TKE_itidal_loss(i,j,a,fr,m) tot_Froude_loss(i,j) = tot_Froude_loss(i,j) + CS%TKE_Froude_loss(i,j,a,fr,m) + tot_residual_loss(i,j) = tot_residual_loss(i,j) + CS%TKE_residual_loss(i,j,a,fr,m) enddo ; enddo ; enddo ; enddo ; enddo do j=js,je ; do i=is,ie tot_allprocesses_loss(i,j) = tot_leak_loss(i,j) + tot_quad_loss(i,j) + & - tot_itidal_loss(i,j) + tot_Froude_loss(i,j) + tot_itidal_loss(i,j) + tot_Froude_loss(i,j) + & + tot_residual_loss(i,j) enddo ; enddo CS%tot_leak_loss = tot_leak_loss CS%tot_quad_loss = tot_quad_loss CS%tot_itidal_loss = tot_itidal_loss CS%tot_Froude_loss = tot_Froude_loss + CS%tot_residual_loss = tot_residual_loss CS%tot_allprocesses_loss = tot_allprocesses_loss if (CS%id_tot_leak_loss > 0) then call post_data(CS%id_tot_leak_loss, tot_leak_loss, CS%diag) @@ -565,6 +590,9 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%id_tot_Froude_loss > 0) then call post_data(CS%id_tot_Froude_loss, tot_Froude_loss, CS%diag) endif + if (CS%id_tot_residual_loss > 0) then + call post_data(CS%id_tot_residual_loss, tot_residual_loss, CS%diag) + endif if (CS%id_tot_allprocesses_loss > 0) then call post_data(CS%id_tot_allprocesses_loss, tot_allprocesses_loss, CS%diag) endif @@ -578,7 +606,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & itidal_loss_mode(i,j) = itidal_loss_mode(i,j) + CS%TKE_itidal_loss(i,j,a,fr,m) allprocesses_loss_mode(i,j) = allprocesses_loss_mode(i,j) + & CS%TKE_leak_loss(i,j,a,fr,m) + CS%TKE_quad_loss(i,j,a,fr,m) + & - CS%TKE_itidal_loss(i,j,a,fr,m) + CS%TKE_Froude_loss(i,j,a,fr,m) + CS%TKE_itidal_loss(i,j,a,fr,m) + CS%TKE_Froude_loss(i,j,a,fr,m) + & + CS%TKE_residual_loss(i,j,a,fr,m) enddo ; enddo ; enddo call post_data(CS%id_itidal_loss_mode(fr,m), itidal_loss_mode, CS%diag) call post_data(CS%id_allprocesses_loss_mode(fr,m), allprocesses_loss_mode, CS%diag) @@ -2150,7 +2179,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) character(len=160) :: var_descript character(len=200) :: filename character(len=200) :: refl_angle_file, land_mask_file - character(len=200) :: refl_pref_file, refl_dbl_file + character(len=200) :: refl_pref_file, refl_dbl_file, trans_file character(len=200) :: dy_Cu_file, dx_Cv_file character(len=200) :: h2_file @@ -2269,6 +2298,9 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "INTERNAL_TIDE_WAVE_DRAG", CS%apply_wave_drag, & "If true, apply scattering due to small-scale roughness as a sink.", & default=.false.) + call get_param(param_file, mdl, "INTERNAL_TIDE_RESIDUAL_DRAG", CS%apply_residual_drag, & + "If true, TBD", & + default=.false.) call get_param(param_file, mdl, "INTERNAL_TIDE_DRAG_MIN_DEPTH", CS%drag_min_depth, & "The minimum total ocean thickness that will be used in the denominator "//& "of the quadratic drag terms for internal tides.", & @@ -2307,10 +2339,12 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%TKE_quad_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) allocate(CS%TKE_itidal_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) allocate(CS%TKE_Froude_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) + allocate(CS%TKE_residual_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) allocate(CS%tot_leak_loss(isd:ied,jsd:jed), source=0.0) allocate(CS%tot_quad_loss(isd:ied,jsd:jed), source=0.0) allocate(CS%tot_itidal_loss(isd:ied,jsd:jed), source=0.0) allocate(CS%tot_Froude_loss(isd:ied,jsd:jed), source=0.0) + allocate(CS%tot_residual_loss(isd:ied,jsd:jed), source=0.0) ! Compute the fixed part of the bottom drag loss from baroclinic modes call get_param(param_file, mdl, "H2_FILE", h2_file, & @@ -2406,6 +2440,32 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) else ; CS%refl_dbl(i,j) = .false. ; endif enddo ; enddo + ! Read in the transmission coefficient and infer the residual + call get_param(param_file, mdl, "TRANS_FILE", trans_file, & + "The path to the file containing the transmission coefficent for internal tides.", & + fail_if_missing=.false., default='') + filename = trim(CS%inputdir) // trim(trans_file) + allocate(CS%trans(isd:ied,jsd:jed), source=0.0) + if (file_exists(filename, G%domain)) then + call log_param(param_file, mdl, "INPUTDIR/TRANS_FILE", filename) + call MOM_read_data(filename, 'trans', CS%trans, G%domain) + else + if (trim(trans_file) /= '' ) call MOM_error(FATAL, & + "TRANS_FILE: "//trim(filename)//" not found") + endif + + call pass_var(CS%trans,G%domain) + ! residual + allocate(CS%residual(isd:ied,jsd:jed), source=0.0) + do j=jsd,jed + do i=isd,ied + if (CS%refl_pref_logical(i,j)) then + CS%residual(i,j) = 1. - CS%refl_pref(i,j) - CS%trans(i,j) + endif + enddo + enddo + call pass_var(CS%residual,G%domain) + ! Read in prescribed land mask from file (if overwriting -BDM). ! This should be done in MOM_initialize_topography subroutine ! defined in MOM_fixed_initialization.F90 (BDM) @@ -2445,6 +2505,10 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) Time, 'Local angle of coastline/ridge/shelf with respect to equator', 'rad') CS%id_refl_pref = register_diag_field('ocean_model', 'refl_pref', diag%axesT1, & Time, 'Partial reflection coefficients', '') + CS%id_trans = register_diag_field('ocean_model', 'trans', diag%axesT1, & + Time, 'Partial transmission coefficients', '') + CS%id_residual = register_diag_field('ocean_model', 'residual', diag%axesT1, & + Time, 'Residual of reflection and transmission coefficients', '') CS%id_dx_Cv = register_diag_field('ocean_model', 'dx_Cv', diag%axesT1, & Time, 'North face unblocked width', 'm', conversion=US%L_to_m) CS%id_dy_Cu = register_diag_field('ocean_model', 'dy_Cu', diag%axesT1, & @@ -2454,6 +2518,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) ! Output reflection parameters as diags here (not needed every timestep) if (CS%id_refl_ang > 0) call post_data(CS%id_refl_ang, CS%refl_angle, CS%diag) if (CS%id_refl_pref > 0) call post_data(CS%id_refl_pref, CS%refl_pref, CS%diag) + if (CS%id_trans > 0) call post_data(CS%id_trans, CS%trans, CS%diag) + if (CS%id_residual > 0) call post_data(CS%id_residual, CS%residual, CS%diag) if (CS%id_dx_Cv > 0) call post_data(CS%id_dx_Cv, G%dx_Cv, CS%diag) if (CS%id_dy_Cu > 0) call post_data(CS%id_dy_Cu, G%dy_Cu, CS%diag) if (CS%id_land_mask > 0) call post_data(CS%id_land_mask, G%mask2dT, CS%diag) @@ -2483,6 +2549,9 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) CS%id_tot_Froude_loss = register_diag_field('ocean_model', 'ITide_tot_Froude_loss', diag%axesT1, & Time, 'Internal tide energy loss to wave breaking', & 'W m-2', conversion=US%RZ3_T3_to_W_m2) + CS%id_tot_residual_loss = register_diag_field('ocean_model', 'ITide_tot_residual_loss', diag%axesT1, & + Time, 'Internal tide energy loss to residual on slopes', & + 'W m-2', conversion=US%RZ3_T3_to_W_m2) CS%id_tot_allprocesses_loss = register_diag_field('ocean_model', 'ITide_tot_allprocesses_loss', diag%axesT1, & Time, 'Internal tide energy loss summed over all processes', & 'W m-2', conversion=US%RZ3_T3_to_W_m2) From 196586dfdc0138fb33cad1a51d94888e3439c87f Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Wed, 8 Dec 2021 14:55:54 -0500 Subject: [PATCH 07/73] add residual term loss on flux --- .../lateral/MOM_internal_tides.F90 | 44 ++++++++++++++----- 1 file changed, 34 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 39d5d4bfa1..b81f32bd4e 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -84,6 +84,7 @@ module MOM_internal_tides real, allocatable, dimension(:,:,:,:,:) :: TKE_itidal_loss !< energy lost due to small-scale wave drag [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_residual_loss + real, allocatable, dimension(:,:,:,:,:) :: local_dissip real, allocatable, dimension(:,:) :: tot_leak_loss !< Energy loss rates due to misc bakground processes, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] @@ -297,8 +298,11 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Propagate the waves. do m=1,CS%NMode ; do fr=1,CS%Nfreq + + CS%local_dissip(:,:,:,fr,m) = 0. + call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt, & - G, US, CS, CS%NAngle) + G, US, CS, CS%NAngle, CS%local_dissip(:,:,:,fr,m)) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -515,10 +519,14 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! loss from residual of reflection/transmission coefficients if (CS%apply_residual_drag) then - do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied - CS%TKE_residual_loss(i,j,a,fr,m) = CS%En(i,j,a,fr,m) * CS%residual(i,j) * CS%decay_rate ! loss rate [R Z3 T-3 ~> W m-2] RD??? - CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + dt * CS%residual(i,j) * CS%decay_rate) ! implicit update + do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied + CS%TKE_residual_loss(i,j,a,fr,m) = CS%local_dissip(i,j,a,fr,m) !* CS%En(i,j,a,fr,m) + ! implicit + !CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + & + ! dt * CS%local_dissip(i,j,a,fr,m) / max(CS%En(i,j,a,fr,m), 1e-16)) + ! explicit works + CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) - dt * CS%local_dissip(i,j,a,fr,m) enddo ; enddo ; enddo ; enddo ; enddo endif @@ -1021,7 +1029,7 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) end subroutine PPM_angular_advect !> Propagates internal waves at a single frequency. -subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) +subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle, local_dissip) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1035,7 +1043,8 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) real, intent(in) :: dt !< Time step [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), intent(in) :: CS !< Internal tide control struct - + real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), & + intent(inout) :: local_dissip ! Local variables real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: & speed ! The magnitude of the group velocity at the q points for corner adv [L T-1 ~> m s-1]. @@ -1126,18 +1135,19 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) ! Apply propagation in x-direction (reflection included) LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, CS%nAngle, CS, LB) + call propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, CS%nAngle, CS, LB, local_dissip) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G, CS, En, 'post-propagate_x') ! Update halos call pass_var(En, G%domain) + call pass_var(local_dissip, G%domain) ! Apply propagation in y-direction (reflection included) ! LB%jsh = js ; LB%jeh = je ; LB%ish = is ; LB%ieh = ie ! Use if no teleport LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, CS%nAngle, CS, LB) + call propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, CS%nAngle, CS, LB, local_dissip) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G, CS, En, 'post-propagate_y') @@ -1412,7 +1422,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS end subroutine propagate_corner_spread !> Propagates the internal wave energy in the logical x-direction. -subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) +subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, local_dissip) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1429,6 +1439,8 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. + real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), & + intent(inout) :: local_dissip ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & EnL, EnR ! Left and right face energy densities [R Z3 T-2 ~> J m-2]. @@ -1465,6 +1477,10 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) do j=jsh,jeh ; do i=ish,ieh Fdt_m(i,j,a) = dt*flux_x(I-1,j) ! left face influx [R Z3 L2 T-2 ~> J] Fdt_p(i,j,a) = -dt*flux_x(I,j) ! right face influx [R Z3 L2 T-2 ~> J] + + local_dissip(i,j,a) = local_dissip(i,j,a) + & + abs(flux_x(I-1,j)) * CS%residual(i,j) * G%IareaT(i,j) + & + abs(flux_x(I,j)) * CS%residual(i,j) * G%IareaT(i,j) enddo ; enddo enddo ! a-loop @@ -1486,7 +1502,7 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) end subroutine propagate_x !> Propagates the internal wave energy in the logical y-direction. -subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) +subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB, local_dissip) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1503,6 +1519,8 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. + real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), & + intent(inout) :: local_dissip ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & EnL, EnR ! South and north face energy densities [R Z3 T-2 ~> J m-2]. @@ -1540,6 +1558,11 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) do j=jsh,jeh ; do i=ish,ieh Fdt_m(i,j,a) = dt*flux_y(i,J-1) ! south face influx [R Z3 L2 T-2 ~> J] Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx [R Z3 L2 T-2 ~> J] + + local_dissip(i,j,a) = local_dissip(i,j,a) + & + abs(flux_y(i,J-1)) * CS%residual(i,j) * G%IareaT(i,j) + & + abs(flux_y(i,J)) * CS%residual(i,j) * G%IareaT(i,j) + !if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) then ! for debugging ! call MOM_error(WARNING, "propagate_y: OutFlux>Available prior to reflection", .true.) ! write(mesg,*) "flux_y_south=",flux_y(i,J-1),"flux_y_north=",flux_y(i,J),"En=",En(i,j,a), & @@ -2340,6 +2363,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%TKE_itidal_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) allocate(CS%TKE_Froude_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) allocate(CS%TKE_residual_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) + allocate(CS%local_dissip(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) allocate(CS%tot_leak_loss(isd:ied,jsd:jed), source=0.0) allocate(CS%tot_quad_loss(isd:ied,jsd:jed), source=0.0) allocate(CS%tot_itidal_loss(isd:ied,jsd:jed), source=0.0) From 6807892e3914c69e674a63f00e909e889c66eed2 Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Wed, 8 Dec 2021 16:25:34 -0500 Subject: [PATCH 08/73] clean up/ move to implicit update --- .../lateral/MOM_internal_tides.F90 | 50 ++++++++++--------- 1 file changed, 26 insertions(+), 24 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index b81f32bd4e..21768ad6ed 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -84,8 +84,7 @@ module MOM_internal_tides real, allocatable, dimension(:,:,:,:,:) :: TKE_itidal_loss !< energy lost due to small-scale wave drag [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_residual_loss - real, allocatable, dimension(:,:,:,:,:) :: local_dissip - + !< internal tide energy loss due to the residual at slopes [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_leak_loss !< Energy loss rates due to misc bakground processes, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_quad_loss !< Energy loss rates due to quadratic bottom drag, @@ -94,8 +93,8 @@ module MOM_internal_tides !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_Froude_loss !< Energy loss rates due to wave breaking, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] - real, allocatable, dimension(:,:) :: tot_residual_loss !< Energy loss rates due to wave breaking, - + real, allocatable, dimension(:,:) :: tot_residual_loss !< Energy loss rates due to residual on slopes, + !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_allprocesses_loss !< Energy loss rates due to all processes, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real :: q_itides !< fraction of local dissipation [nondim] @@ -210,6 +209,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & real :: loss_rate ! An energy loss rate [T-1 ~> s-1] real :: Fr2_max real :: cn_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] + real :: en_subRO ! A tiny energy to prevent division by zero [R Z3 T-2 ~> J m-2] real :: En_new, En_check ! Energies for debugging [R Z3 T-2 ~> J m-2] real :: En_initial, Delta_E_check ! Energies for debugging [R Z3 T-2 ~> J m-2] real :: TKE_Froude_loss_check, TKE_Froude_loss_tot ! Energy losses for debugging [R Z3 T-3 ~> W m-2] @@ -223,7 +223,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nAngle = CS%NAngle I_rho0 = 1.0 / GV%Rho0 - cn_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. + cn_subRO = 1e-30*US%m_s_to_L_T ! The hard-coded value here might need to increase. + en_subRO = 1e-30*US%W_m2_to_RZ3_T3*US%s_to_T ! init local arrays drag_scale(:,:) = 0. @@ -299,10 +300,10 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Propagate the waves. do m=1,CS%NMode ; do fr=1,CS%Nfreq - CS%local_dissip(:,:,:,fr,m) = 0. + CS%TKE_residual_loss(:,:,:,fr,m) = 0. call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt, & - G, US, CS, CS%NAngle, CS%local_dissip(:,:,:,fr,m)) + G, US, CS, CS%NAngle, CS%TKE_residual_loss(:,:,:,fr,m)) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -521,12 +522,11 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%apply_residual_drag) then do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied - CS%TKE_residual_loss(i,j,a,fr,m) = CS%local_dissip(i,j,a,fr,m) !* CS%En(i,j,a,fr,m) ! implicit - !CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + & - ! dt * CS%local_dissip(i,j,a,fr,m) / max(CS%En(i,j,a,fr,m), 1e-16)) - ! explicit works - CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) - dt * CS%local_dissip(i,j,a,fr,m) + CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + dt * CS%TKE_residual_loss(i,j,a,fr,m) / & + (CS%En(i,j,a,fr,m) + en_subRO)) + ! explicit + !CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) - dt * CS%TKE_residual_loss(i,j,a,fr,m) enddo ; enddo ; enddo ; enddo ; enddo endif @@ -1029,7 +1029,7 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) end subroutine PPM_angular_advect !> Propagates internal waves at a single frequency. -subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle, local_dissip) +subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle, residual_loss) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1044,7 +1044,8 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle, local_dissip) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), intent(in) :: CS !< Internal tide control struct real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), & - intent(inout) :: local_dissip + intent(inout) :: residual_loss !< internal tide energy loss due + !! to the residual at slopes [R Z3 T-3 ~> W m-2]. ! Local variables real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: & speed ! The magnitude of the group velocity at the q points for corner adv [L T-1 ~> m s-1]. @@ -1135,19 +1136,19 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle, local_dissip) ! Apply propagation in x-direction (reflection included) LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, CS%nAngle, CS, LB, local_dissip) + call propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, CS%nAngle, CS, LB, residual_loss) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G, CS, En, 'post-propagate_x') ! Update halos call pass_var(En, G%domain) - call pass_var(local_dissip, G%domain) + call pass_var(residual_loss, G%domain) ! Apply propagation in y-direction (reflection included) ! LB%jsh = js ; LB%jeh = je ; LB%ish = is ; LB%ieh = ie ! Use if no teleport LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, CS%nAngle, CS, LB, local_dissip) + call propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, CS%nAngle, CS, LB, residual_loss) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G, CS, En, 'post-propagate_y') @@ -1422,7 +1423,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS end subroutine propagate_corner_spread !> Propagates the internal wave energy in the logical x-direction. -subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, local_dissip) +subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, residual_loss) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1440,7 +1441,8 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, loc type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), & - intent(inout) :: local_dissip + intent(inout) :: residual_loss !< internal tide energy loss due + !! to the residual at slopes [R Z3 T-3 ~> W m-2]. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & EnL, EnR ! Left and right face energy densities [R Z3 T-2 ~> J m-2]. @@ -1478,7 +1480,7 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, loc Fdt_m(i,j,a) = dt*flux_x(I-1,j) ! left face influx [R Z3 L2 T-2 ~> J] Fdt_p(i,j,a) = -dt*flux_x(I,j) ! right face influx [R Z3 L2 T-2 ~> J] - local_dissip(i,j,a) = local_dissip(i,j,a) + & + residual_loss(i,j,a) = residual_loss(i,j,a) + & abs(flux_x(I-1,j)) * CS%residual(i,j) * G%IareaT(i,j) + & abs(flux_x(I,j)) * CS%residual(i,j) * G%IareaT(i,j) enddo ; enddo @@ -1502,7 +1504,7 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, loc end subroutine propagate_x !> Propagates the internal wave energy in the logical y-direction. -subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB, local_dissip) +subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB, residual_loss) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1520,7 +1522,8 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB, loc type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), & - intent(inout) :: local_dissip + intent(inout) :: residual_loss !< internal tide energy loss due + !! to the residual at slopes [R Z3 T-3 ~> W m-2]. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & EnL, EnR ! South and north face energy densities [R Z3 T-2 ~> J m-2]. @@ -1559,7 +1562,7 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB, loc Fdt_m(i,j,a) = dt*flux_y(i,J-1) ! south face influx [R Z3 L2 T-2 ~> J] Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx [R Z3 L2 T-2 ~> J] - local_dissip(i,j,a) = local_dissip(i,j,a) + & + residual_loss(i,j,a) = residual_loss(i,j,a) + & abs(flux_y(i,J-1)) * CS%residual(i,j) * G%IareaT(i,j) + & abs(flux_y(i,J)) * CS%residual(i,j) * G%IareaT(i,j) @@ -2363,7 +2366,6 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%TKE_itidal_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) allocate(CS%TKE_Froude_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) allocate(CS%TKE_residual_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) - allocate(CS%local_dissip(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) allocate(CS%tot_leak_loss(isd:ied,jsd:jed), source=0.0) allocate(CS%tot_quad_loss(isd:ied,jsd:jed), source=0.0) allocate(CS%tot_itidal_loss(isd:ied,jsd:jed), source=0.0) From 833cd301042e9ef95c3215a62595f800077a7cbd Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 5 Dec 2021 10:01:34 -0500 Subject: [PATCH 09/73] +Remove clocks inside of j-loops Removed clocks that were being called from inside of j-loops in two modules. These are inefficient and can cause the model to hang in some cases if used, and there are better ways to get timing information at this level. If there is interest in the timing breakdown at this level, the code should be restructured to move the key blocks outside of the j-loops. The run-time parameter ALLOW_CLOCKS_IN_OMP_LOOPS is no longer being used so it is now obsoleted. All answers are bitwise identical, but there are changes to some MOM_parameter_doc files. --- src/diagnostics/MOM_obsolete_params.F90 | 1 + .../vertical/MOM_bulk_mixed_layer.F90 | 54 +------------------ .../vertical/MOM_regularize_layers.F90 | 18 +------ 3 files changed, 5 insertions(+), 68 deletions(-) diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index 034b87e91b..c579241ffe 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -87,6 +87,7 @@ subroutine find_obsolete_params(param_file) call obsolete_logical(param_file, "MSTAR_FIXED", hint="Instead use MSTAR_MODE.") call obsolete_logical(param_file, "USE_VISBECK_SLOPE_BUG", .false.) + call obsolete_logical(param_file, "ALLOW_CLOCKS_IN_OMP_LOOPS", .true.) call obsolete_logical(param_file, "LARGE_FILE_SUPPORT", .true.) call obsolete_real(param_file, "MIN_Z_DIAG_INTERVAL") call obsolete_char(param_file, "Z_OUTPUT_GRID_FILE") diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index c80ee0ea61..046329523d 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -136,8 +136,6 @@ module MOM_bulk_mixed_layer !! detrainment [R Z L2 T-3 ~> W m-2]. diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only !! detrainment [R Z L2 T-3 ~> W m-2]. - logical :: allow_clocks_in_omp_loops !< If true, clocks can be called from inside loops that can - !! be threaded. To run with multiple threads, set to False. type(group_pass_type) :: pass_h_sum_hmbl_prev !< For group halo pass !>@{ Diagnostic IDs @@ -150,8 +148,7 @@ module MOM_bulk_mixed_layer end type bulkmixedlayer_CS !>@{ CPU clock IDs -integer :: id_clock_detrain=0, id_clock_mech=0, id_clock_conv=0, id_clock_adjustment=0 -integer :: id_clock_EOS=0, id_clock_resort=0, id_clock_pass=0 +integer :: id_clock_pass=0 !>@} contains @@ -433,7 +430,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C d_ea(i,k) = 0.0 ; d_eb(i,k) = 0.0 enddo ; enddo - if (id_clock_EOS>0) call cpu_clock_begin(id_clock_EOS) ! Calculate an estimate of the mid-mixed layer pressure [R L2 T-2 ~> Pa] if (associated(tv%p_surf)) then do i=is,ie ; p_ref(i) = tv%p_surf(i,j) ; enddo @@ -449,27 +445,22 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C call calculate_density(T(:,k), S(:,k), p_ref, R0(:,k), tv%eqn_of_state, EOSdom) call calculate_density(T(:,k), S(:,k), p_ref_cv, Rcv(:,k), tv%eqn_of_state, EOSdom) enddo - if (id_clock_EOS>0) call cpu_clock_end(id_clock_EOS) if (CS%ML_resort) then - if (id_clock_resort>0) call cpu_clock_begin(id_clock_resort) if (CS%ML_presort_nz_conv_adj > 0) & call convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, dKE_CA, cTKE, j, G, GV, & US, CS, CS%ML_presort_nz_conv_adj) call sort_ML(h, R0, eps, G, GV, CS, ksort) - if (id_clock_resort>0) call cpu_clock_end(id_clock_resort) else do k=1,nz ; do i=is,ie ; ksort(i,k) = k ; enddo ; enddo - if (id_clock_adjustment>0) call cpu_clock_begin(id_clock_adjustment) ! Undergo instantaneous entrainment into the buffer layers and mixed layers ! to remove hydrostatic instabilities. Any water that is lighter than ! currently in the mixed or buffer layer is entrained. call convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, dKE_CA, cTKE, j, G, GV, US, CS) do i=is,ie ; h_CA(i) = h(i,1) ; enddo - if (id_clock_adjustment>0) call cpu_clock_end(id_clock_adjustment) endif if (associated(fluxes%lrunoff) .and. CS%do_rivermix) then @@ -493,9 +484,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C do i=is,ie ; TKE_river(i) = 0.0 ; enddo endif - - if (id_clock_conv>0) call cpu_clock_begin(id_clock_conv) - ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: ! netMassInOut = water [H ~> m or kg m-2] added/removed via surface fluxes @@ -515,16 +503,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C nsw, Pen_SW_bnd, opacity_band, Conv_En, dKE_FC, & j, ksort, G, GV, US, CS, tv, fluxes, dt, aggregate_FW_forcing) - if (id_clock_conv>0) call cpu_clock_end(id_clock_conv) - ! Now the mixed layer undergoes mechanically forced entrainment. ! The mixed layer may entrain down to the Monin-Obukhov depth if the ! surface is becoming lighter, and is effecti1336vely detraining. ! First the TKE at the depth of free convection that is available ! to drive mixing is calculated. - if (id_clock_mech>0) call cpu_clock_begin(id_clock_mech) - call find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, & TKE, TKE_river, Idecay_len_TKE, cMKE, dt, Idt_diag, & j, ksort, G, GV, US, CS) @@ -542,7 +526,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C if (CS%TKE_diagnostics) then ; do i=is,ie CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) - Idt_diag * TKE(i) enddo ; endif - if (id_clock_mech>0) call cpu_clock_end(id_clock_mech) ! Calculate the homogeneous mixed layer properties and store them in layer 0. do i=is,ie ; if (htot(i) > 0.0) then @@ -572,10 +555,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! these unused layers (but not currently in the code). if (CS%ML_resort) then - if (id_clock_resort>0) call cpu_clock_begin(id_clock_resort) call resort_ML(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), GV%Rlay(:), eps, & d_ea, d_eb, ksort, G, GV, CS, dR0_dT, dR0_dS, dRcv_dT, dRcv_dS) - if (id_clock_resort>0) call cpu_clock_end(id_clock_resort) endif if (CS%limit_det .or. (CS%id_Hsfc_max > 0) .or. (CS%id_Hsfc_min > 0)) then @@ -606,7 +587,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! Move water left in the former mixed layer into the buffer layer and ! from the buffer layer into the interior. These steps might best be ! treated in conjuction. - if (id_clock_detrain>0) call cpu_clock_begin(id_clock_detrain) if (CS%nkbl == 1) then call mixedlayer_detrain_1(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), & GV%Rlay(:), dt, dt__diag, d_ea, d_eb, j, G, GV, US, CS, & @@ -619,8 +599,6 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! This code only works with 1 or 2 buffer layers. call MOM_error(FATAL, "MOM_mixed_layer: CS%nkbl must be 1 or 2 for now.") endif - if (id_clock_detrain>0) call cpu_clock_end(id_clock_detrain) - if (CS%id_Hsfc_used > 0) then do i=is,ie ; Hsfc_used(i,j) = GV%H_to_Z * h(i,0) ; enddo @@ -3526,12 +3504,6 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "If true, use code with a bug that causes a loss of momentum conservation "//& "during mixedlayer convection.", default=.false.) - call get_param(param_file, mdl, "ALLOW_CLOCKS_IN_OMP_LOOPS", & - CS%allow_clocks_in_omp_loops, & - "If true, clocks can be called from inside loops that can "//& - "be threaded. To run with multiple threads, set to False.", & - default=.true.) - CS%id_ML_depth = register_diag_field('ocean_model', 'h_ML', diag%axesT1, & Time, 'Surface mixed layer depth', 'm') CS%id_TKE_wind = register_diag_field('ocean_model', 'TKE_wind', diag%axesT1, & @@ -3610,30 +3582,8 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) if (CS%id_PE_detrain2 > 0) call safe_alloc_alloc(CS%diag_PE_detrain2, isd, ied, jsd, jed) if (CS%id_ML_depth > 0) call safe_alloc_alloc(CS%ML_depth, isd, ied, jsd, jed) - if (CS%allow_clocks_in_omp_loops) then - id_clock_detrain = cpu_clock_id('(Ocean mixed layer detrain)', & - sync=.false., grain=CLOCK_ROUTINE) - id_clock_mech = cpu_clock_id('(Ocean mixed layer mechanical entrainment)', & - sync=.false., grain=CLOCK_ROUTINE) - id_clock_conv = cpu_clock_id('(Ocean mixed layer convection)', & - sync=.false., grain=CLOCK_ROUTINE) - if (CS%ML_resort) then - id_clock_resort = cpu_clock_id('(Ocean mixed layer resorting)', & - sync=.false., grain=CLOCK_ROUTINE) - else - id_clock_adjustment = cpu_clock_id('(Ocean mixed layer convective adjustment)', & - sync=.false., grain=CLOCK_ROUTINE) - endif - id_clock_EOS = cpu_clock_id('(Ocean mixed layer EOS)', & - sync=.false., grain=CLOCK_ROUTINE) - endif - if (CS%limit_det .or. (CS%id_Hsfc_min > 0)) & - id_clock_pass = cpu_clock_id('(Ocean mixed layer halo updates)', grain=CLOCK_ROUTINE) - - -! if (CS%limit_det) then -! endif + id_clock_pass = cpu_clock_id('(Ocean mixed layer halo updates)', grain=CLOCK_ROUTINE) end subroutine bulkmixedlayer_init diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 868ff6a832..1f141ffd0f 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -56,13 +56,11 @@ module MOM_regularize_layers logical :: debug !< If true, do more thorough checks for debugging purposes. integer :: id_def_rat = -1 !< A diagnostic ID - logical :: allow_clocks_in_omp_loops !< If true, clocks can be called from inside loops that - !! can be threaded. To run with multiple threads, set to False. end type regularize_layers_CS !>@{ Clock IDs !! \todo Should these be global? -integer :: id_clock_pass, id_clock_EOS +integer :: id_clock_pass !>@} contains @@ -233,12 +231,10 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) ! Now restructure the layers. !$OMP parallel do default(private) shared(is,ie,js,je,nz,do_j,def_rat_h,CS,nkmb,G,GV,US, & !$OMP e,I_dtol,h,tv,debug,h_neglect,p_ref_cv,ea, & - !$OMP eb,id_clock_EOS,nkml,EOSdom) + !$OMP eb,nkml,EOSdom) do j=js,je ; if (do_j(j)) then -! call cpu_clock_begin(id_clock_EOS) ! call calculate_density_derivs(T(:,1), S(:,1), p_ref_cv, dRcv_dT, dRcv_dS, tv%eqn_of_state, EOSdom) -! call cpu_clock_end(id_clock_EOS) do k=1,nz ; do i=is,ie ; d_ea(i,k) = 0.0 ; d_eb(i,k) = 0.0 ; enddo ; enddo kmax_d_ea = 0 @@ -367,11 +363,9 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) enddo endif if (det_any) then - call cpu_clock_begin(id_clock_EOS) do k=1,nkmb call calculate_density(T_2d(:,k), S_2d(:,k), p_ref_cv, Rcv(:,k), tv%eqn_of_state, EOSdom) enddo - call cpu_clock_end(id_clock_EOS) do i=is,ie ; if (det_i(i)) then k1 = nkmb ; k2 = nz @@ -780,19 +774,11 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) ! call get_param(param_file, mdl, "DEBUG_CONSERVATION", CS%debug, & ! "If true, monitor conservation and extrema.", default=.false., do_not_log=just_read) - call get_param(param_file, mdl, "ALLOW_CLOCKS_IN_OMP_LOOPS", CS%allow_clocks_in_omp_loops, & - "If true, clocks can be called from inside loops that can "//& - "be threaded. To run with multiple threads, set to False.", & - default=.true., do_not_log=just_read) - if (.not.CS%regularize_surface_layers) return CS%id_def_rat = register_diag_field('ocean_model', 'deficit_ratio', diag%axesT1, & Time, 'Max face thickness deficit ratio', 'nondim') - if (CS%allow_clocks_in_omp_loops) then - id_clock_EOS = cpu_clock_id('(Ocean regularize_layers EOS)', grain=CLOCK_ROUTINE) - endif id_clock_pass = cpu_clock_id('(Ocean regularize_layers halo updates)', grain=CLOCK_ROUTINE) end subroutine regularize_layers_init From 8b5c1c87ff114e85fb53a8d54b7bc49c1ada666f Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 5 Dec 2021 10:10:18 -0500 Subject: [PATCH 10/73] Deallocate eta_PF_start to avoid a memory leak Added a deallocate call for eta_PF_start in step_MOM_dyn_split_RK2() to avoid a possible memory leak. All answers are bitwise identical. --- src/core/MOM_dynamics_split_RK2.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index d3ad0a0a92..a762da7f33 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -865,11 +865,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s enddo ; enddo enddo - ! The time-averaged free surface height has already been set by the last - ! call to btstep. + ! The time-averaged free surface height has already been set by the last call to btstep. - ! Deallocate this memory to avoid a memory leak. ###We should also revisit how this array is declared. - RWH - !### if (dyn_p_surf .and. associated(eta_PF_start)) deallocate(eta_PF_start) + ! Deallocate this memory to avoid a memory leak. ### We should revisit how this array is declared. -RWH + if (dyn_p_surf .and. associated(eta_PF_start)) deallocate(eta_PF_start) ! Here various terms used in to update the momentum equations are ! offered for time averaging. From 3f46b6a7f060a563a2ebb6be77ca86eedc44cfbe Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 5 Dec 2021 12:25:30 -0500 Subject: [PATCH 11/73] +Set find_salt_root if SHELF_THREE_EQN = .False. Set find_salt_root even if SHELF_THREE_EQN = .False. to avoid using an uninitialized logical to determine which parameters are logged. Without this the contents of some MOM_parameter_doc.all files could depend on the state of uninitialized memory and was compiler dependent in some cases. All answers are bitwise identical, but in some cases the contents of MOM_parameter_doc files could be corrected. --- src/ice_shelf/MOM_ice_shelf.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 77166cece0..bbc23bdc5e 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1409,12 +1409,12 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, "If true, user specifies a constant nondimensional heat-transfer coefficient "//& "(GAMMA_T_3EQ), from which the default salt-transfer coefficient is set "//& "as GAMMA_T_3EQ/35. This is used with SHELF_THREE_EQN.", default=.false.) - if (CS%threeeq) then - call get_param(param_file, mdl, "SHELF_S_ROOT", CS%find_salt_root, & + call get_param(param_file, mdl, "SHELF_S_ROOT", CS%find_salt_root, & "If SHELF_S_ROOT = True, salinity at the ice/ocean interface (Sbdry) "//& "is computed from a quadratic equation. Otherwise, the previous "//& - "interactive method to estimate Sbdry is used.", default=.false.) - else + "interactive method to estimate Sbdry is used.", & + default=.false., do_not_log=.not.CS%threeeq) + if (.not.CS%threeeq) then call get_param(param_file, mdl, "SHELF_2EQ_GAMMA_T", CS%gamma_t, & "If SHELF_THREE_EQN is false, this the fixed turbulent "//& "exchange velocity at the ice-ocean interface.", & From ec553aa93c59538da6387f1f7c173848f0ade1ef Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sun, 5 Dec 2021 12:27:34 -0500 Subject: [PATCH 12/73] +Obsolete ETA_TOLERANCE_AUX The runtime parameter ETA_TOLERANCE_AUX was being read but was never used, so it is being obsoleted. However, because some experiments were using this and there are effectively no changes in behavior, a warning will be issued instead of a fatal error if this parameter is set. All answers are bitwise identical, but there are changes to some MOM_parameter_doc files. --- src/core/MOM_continuity_PPM.F90 | 22 +++++----------------- src/diagnostics/MOM_obsolete_params.F90 | 9 +++++++-- 2 files changed, 12 insertions(+), 19 deletions(-) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 4e037998c9..15a6bf72a3 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -41,10 +41,6 @@ module MOM_continuity_PPM real :: tol_vel !< The tolerance for barotropic velocity !! discrepancies between the barotropic solution and !! the sum of the layer thicknesses [L T-1 ~> m s-1]. - real :: tol_eta_aux !< The tolerance for free-surface height - !! discrepancies between the barotropic solution and - !! the sum of the layer thicknesses when calculating - !! the auxiliary corrected velocities [H ~> m or kg m-2]. real :: CFL_limit_adjust !< The maximum CFL of the adjusted velocities [nondim] logical :: aggress_adjust !< If true, allow the adjusted velocities to have a !! relative CFL change up to 0.5. False by default. @@ -2234,9 +2230,9 @@ subroutine continuity_PPM_init(Time, G, GV, US, param_file, diag, CS) type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to !! regulate diagnostic output. type(continuity_PPM_CS), intent(inout) :: CS !< Module's control structure. -!> This include declares and sets the variable "version". -#include "version_variable.h" - real :: tol_eta_m ! An unscaled version of tol_eta [m]. + + !> This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_continuity_PPM" ! This module's name. CS%initialized = .true. @@ -2267,16 +2263,8 @@ subroutine continuity_PPM_init(Time, G, GV, US, param_file, diag, CS) "tolerance for SSH is 4 times this value. The default "//& "is 0.5*NK*ANGSTROM, and this should not be set less "//& "than about 10^-15*MAXIMUM_DEPTH.", units="m", scale=GV%m_to_H, & - default=0.5*GV%ke*GV%Angstrom_m, unscaled=tol_eta_m) - - !### ETA_TOLERANCE_AUX can be obsoleted. - call get_param(param_file, mdl, "ETA_TOLERANCE_AUX", CS%tol_eta_aux, & - "The tolerance for free-surface height discrepancies "//& - "between the barotropic solution and the sum of the "//& - "layer thicknesses when calculating the auxiliary "//& - "corrected velocities. By default, this is the same as "//& - "ETA_TOLERANCE, but can be made larger for efficiency.", & - units="m", default=tol_eta_m, scale=GV%m_to_H) + default=0.5*GV%ke*GV%Angstrom_m) + call get_param(param_file, mdl, "VELOCITY_TOLERANCE", CS%tol_vel, & "The tolerance for barotropic velocity discrepancies "//& "between the barotropic solution and the sum of the "//& diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index c579241ffe..dfadaa1da5 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -80,6 +80,7 @@ subroutine find_obsolete_params(param_file) "find_obsolete_params: #define DYNAMIC_SURFACE_PRESSURE is not yet "//& "implemented without #define SPLIT.") + call obsolete_real(param_file, "ETA_TOLERANCE_AUX", only_warn=.true.) call obsolete_real(param_file, "BT_MASS_SOURCE_LIMIT", 0.0) call obsolete_int(param_file, "SEAMOUNT_LENGTH_SCALE", hint="Use SEAMOUNT_X_LENGTH_SCALE instead.") @@ -174,21 +175,25 @@ subroutine obsolete_char(param_file, varname, warning_val, hint) end subroutine obsolete_char !> Test for presence of obsolete REAL in parameter file. -subroutine obsolete_real(param_file, varname, warning_val, hint) +subroutine obsolete_real(param_file, varname, warning_val, hint, only_warn) type(param_file_type), intent(in) :: param_file !< Structure containing parameter file data. character(len=*), intent(in) :: varname !< Name of obsolete REAL parameter. real, optional, intent(in) :: warning_val !< An allowed value that causes a warning instead of an error. character(len=*), optional, intent(in) :: hint !< A hint to the user about what to do. + logical, optional, intent(in) :: only_warn !< If present and true, issue warnings instead of fatal errors. + ! Local variables real :: test_val, warn_val + logical :: issue_warning character(len=128) :: hint_msg test_val = -9e35; call read_param(param_file, varname, test_val) warn_val = -9e35; if (present(warning_val)) warn_val = warning_val hint_msg = " " ; if (present(hint)) hint_msg = hint + issue_warning = .false. ; if (present(only_warn)) issue_warning = only_warn if (test_val /= -9e35) then - if (test_val == warn_val) then + if ((test_val == warn_val) .or. issue_warning) then call MOM_ERROR(WARNING, "MOM_obsolete_params: "//trim(varname)// & " is an obsolete run-time flag. "//trim(hint_msg)) else From d7337145ec3ae4aef8b4a9d6030672a8c1ed336c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 10 Dec 2021 10:09:26 -0500 Subject: [PATCH 13/73] (*)Fix extract_diabatic_member Return the diabatic_aux_CSp from extract_diabatic_member it is present as an optional argument. Somehow this was omitted when this routine was created, but without this correction the offline tracer mode returns a segmentation fault. Also, added the proper conversion factor in the register_diag_field call for e_predia, and internally calculate the interface heights in units of [Z ~> m] for dimensional consistency testing. All answers are bitwise identical in cases that ran before. --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 77ec87b230..1b68cf8211 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -294,7 +294,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & - eta ! Interface heights before diapycnal mixing [m]. + eta ! Interface heights before diapycnal mixing [Z ~> m] real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & cn_IGW ! baroclinic internal gravity wave speeds [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: temp_diag ! Previous temperature for diagnostics [degC] @@ -326,7 +326,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) if (CS%id_e_predia > 0) then - call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0, dZref=G%Z_ref) + call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) call post_data(CS%id_e_predia, eta, CS%diag) endif @@ -2536,6 +2536,7 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, if (present(optics_CSp)) optics_CSp => CS%optics if (present(KPP_CSp)) KPP_CSp => CS%KPP_CSp if (present(energetic_PBL_CSp)) energetic_PBL_CSp => CS%energetic_PBL + if (present(diabatic_aux_CSp)) diabatic_aux_CSp => CS%diabatic_aux_CSp ! Constants within diabatic_CS if (present(evap_CFL_limit)) evap_CFL_limit = CS%evap_CFL_limit @@ -3175,7 +3176,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di 'Layer Thickness before diabatic forcing', & trim(thickness_units), conversion=GV%H_to_MKS, v_extensive=.true.) CS%id_e_predia = register_diag_field('ocean_model', 'e_predia', diag%axesTi, Time, & - 'Interface Heights before diabatic forcing', 'm') + 'Interface Heights before diabatic forcing', 'm', conversion=US%Z_to_m) if (use_temperature) then CS%id_T_predia = register_diag_field('ocean_model', 'temp_predia', diag%axesTL, Time, & 'Potential Temperature', 'degC') From 5172c495c3505a7565448d91ff48c487148f5500 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 10 Dec 2021 10:10:16 -0500 Subject: [PATCH 14/73] Warn if opacity_from_chl is called without fluxes Issue a warning with a helpful message if opacity_from_chl is called with no shortwave fluxes, and added logical tests to avoid a segmentation fault later in this routine. This should not happen, as it makes no sense, but it was occurring with the offline tracer code, and can be avoided by setting PEN_SW_NBANDS=0 if there are no shortwave fluxes to penetrate. Also turned the real dimensional parameter op_diag_len into a variable and set it immediately before where it is used. Many spelling errors were also corrected in MOM_opacity.F90. All answers are identical in cases that ran before. --- .../vertical/MOM_opacity.F90 | 89 +++++++++++-------- 1 file changed, 52 insertions(+), 37 deletions(-) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 02d49d024d..a99524060b 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -47,7 +47,7 @@ module MOM_opacity end type optics_type -!> The control structure with paramters for the MOM_opacity module +!> The control structure with parameters for the MOM_opacity module type, public :: opacity_CS ; private logical :: var_pen_sw !< If true, use one of the CHL_A schemes (specified by OPACITY_SCHEME) to !! determine the e-folding depth of incoming shortwave radiation. @@ -67,6 +67,7 @@ module MOM_opacity !! The default is 10 m-1 - a value for muddy water. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. + logical :: warning_issued !< A flag that is used to avoid repetative warnings. !>@{ Diagnostic IDs integer :: id_sw_pen = -1, id_sw_vis_pen = -1 @@ -83,9 +84,6 @@ module MOM_opacity character*(10), parameter :: SINGLE_EXP_STRING = "SINGLE_EXP" !< String to specify the opacity scheme character*(10), parameter :: DOUBLE_EXP_STRING = "DOUBLE_EXP" !< String to specify the opacity scheme -real, parameter :: op_diag_len = 1e-10 !< Lengthscale L used to remap opacity - !! from op to 1/L * tanh(op * L) - contains !> This sets the opacity of sea water based based on one of several different schemes. @@ -103,24 +101,26 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(opacity_CS) :: CS !< The control structure earlier set up by opacity_init. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] + optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentrations [mg m-3] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(in) :: chl_3d !< The chlorophyll-A concentractions of each layer [mg m-3] + optional, intent(in) :: chl_3d !< The chlorophyll-A concentrations of each layer [mg m-3] ! Local variables integer :: i, j, k, n, is, ie, js, je, nz real :: inv_sw_pen_scale ! The inverse of the e-folding scale [m-1]. real :: Inv_nbands ! The inverse of the number of bands of penetrating - ! shortwave radiation. + ! shortwave radiation [nondim] logical :: call_for_surface ! if horizontal slice is the surface layer real :: tmp(SZI_(G),SZJ_(G),SZK_(GV)) ! A 3-d temporary array. real :: chl(SZI_(G),SZJ_(G),SZK_(GV)) ! The concentration of chlorophyll-A [mg m-3]. real :: Pen_SW_tot(SZI_(G),SZJ_(G)) ! The penetrating shortwave radiation ! summed across all bands [Q R Z T-1 ~> W m-2]. + real :: op_diag_len ! A tiny lengthscale [m] used to remap opacity + ! from op to 1/op_diag_len * tanh(op * op_diag_len) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (present(chl_2d) .or. present(chl_3d)) then - ! The optical properties are based on cholophyll concentrations. + ! The optical properties are based on chlorophyll concentrations. call opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & G, GV, US, CS, chl_2d, chl_3d) else ! Use sw e-folding scale set by MOM_input @@ -199,11 +199,12 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ call post_data(CS%id_sw_vis_pen, Pen_SW_tot, CS%diag) endif do n=1,optics%nbands ; if (CS%id_opacity(n) > 0) then + op_diag_len = 1e-10 ! A dimensional depth to constrain the range of opacity [m] !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie ! Remap opacity (op) to 1/L * tanh(op * L) where L is one Angstrom. ! This gives a nearly identical value when op << 1/L but allows one to - ! store the values when opacity is divergent (i.e. opaque). + ! record the values even at reduced precision when opacity is huge (i.e. opaque). tmp(i,j,k) = tanh(op_diag_len * optics%opacity_band(n,i,j,k)) / op_diag_len enddo ; enddo ; enddo call post_data(CS%id_opacity(n), tmp, CS%diag) @@ -213,12 +214,12 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ end subroutine set_opacity -!> This sets the "blue" band opacity based on chloophyll A concencentrations +!> This sets the "blue" band opacity based on chlorophyll A concentrations !! The red portion is lumped into the net heating at the surface. subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & G, GV, US, CS, chl_2d, chl_3d) type(optics_type), intent(inout) :: optics !< An optics structure that has values - !! set based on the opacities. + !! set based on the opacities. real, dimension(:,:), pointer :: sw_total !< Total shortwave flux into the ocean [Q R Z T-1 ~> W m-2] real, dimension(:,:), pointer :: sw_vis_dir !< Visible, direct shortwave into the ocean [Q R Z T-1 ~> W m-2] real, dimension(:,:), pointer :: sw_vis_dif !< Visible, diffuse shortwave into the ocean [Q R Z T-1 ~> W m-2] @@ -229,15 +230,15 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(opacity_CS) :: CS !< The control structure. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] + optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentrations [mg m-3] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(in) :: chl_3d !< A 3-d field of chlorophyll-A concentractions [mg m-3] + optional, intent(in) :: chl_3d !< A 3-d field of chlorophyll-A concentrations [mg m-3] real :: chl_data(SZI_(G),SZJ_(G)) ! The chlorophyll A concentrations in a layer [mg m-3]. real :: Inv_nbands ! The inverse of the number of bands of penetrating - ! shortwave radiation. + ! shortwave radiation [nondim] real :: Inv_nbands_nir ! The inverse of the number of bands of penetrating - ! near-infrafed radiation. + ! near-infrared radiation [nondim] real :: SW_pen_tot ! The sum across the bands of the penetrating ! shortwave radiation [Q R Z T-1 ~> W m-2]. real :: SW_vis_tot ! The sum across the visible bands of shortwave @@ -247,7 +248,7 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir type(time_type) :: day character(len=128) :: mesg integer :: i, j, k, n, is, ie, js, je, nz, nbands - logical :: multiband_vis_input, multiband_nir_input + logical :: multiband_vis_input, multiband_nir_input, total_sw_input is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -257,9 +258,9 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir ! into the net heating at the surface. ! ! Morel, A., Optical modeling of the upper ocean in relation to its biogenous -! matter content (case-i waters).,J. Geo. Res., {93}, 10,749--10,768, 1988. +! matter content (case-i waters)., J. Geo. Res., {93}, 10,749--10,768, 1988. ! -! Manizza, M., C.~L. Quere, A.~Watson, and E.~T. Buitenhuis, Bio-optical +! Manizza, M., C. L. Quere, A. Watson, and E. T. Buitenhuis, Bio-optical ! feedbacks among phytoplankton, upper ocean physics and sea-ice in a ! global model, Geophys. Res. Let., , L05,603, 2005. @@ -271,10 +272,19 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir if (nbands <= 2) then ; Inv_nbands_nir = 0.0 else ; Inv_nbands_nir = 1.0 / real(nbands - 2.0) ; endif - multiband_vis_input = (associated(sw_vis_dir) .and. & - associated(sw_vis_dif)) - multiband_nir_input = (associated(sw_nir_dir) .and. & - associated(sw_nir_dif)) + if (.not.(associated(sw_total) .or. (associated(sw_vis_dir) .and. associated(sw_vis_dif) .and. & + associated(sw_nir_dir) .and. associated(sw_nir_dif)) )) then + if (.not.CS%warning_issued) then + call MOM_error(WARNING, & + "opacity_from_chl called without any shortwave flux arrays allocated.\n"//& + "Consider setting PEN_SW_NBANDS = 0 if no shortwave fluxes are being used.") + endif + CS%warning_issued = .true. + endif + + multiband_vis_input = (associated(sw_vis_dir) .and. associated(sw_vis_dif)) + multiband_nir_input = (associated(sw_nir_dir) .and. associated(sw_nir_dif)) + total_sw_input = associated(sw_total) chl_data(:,:) = 0.0 if (present(chl_3d)) then @@ -298,7 +308,7 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir endif enddo ; enddo else - call MOM_error(FATAL, "Either chl_2d or chl_3d must be preesnt in a call to opacity_form_chl.") + call MOM_error(FATAL, "Either chl_2d or chl_3d must be present in a call to opacity_form_chl.") endif select case (CS%opacity_scheme) @@ -309,12 +319,13 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir if (G%mask2dT(i,j) > 0.5) then if (multiband_vis_input) then SW_vis_tot = sw_vis_dir(i,j) + sw_vis_dif(i,j) - else ! Follow Manizza 05 in assuming that 42% of SW is visible. + elseif (total_sw_input) then + ! Follow Manizza 05 in assuming that 42% of SW is visible. SW_vis_tot = 0.42 * sw_total(i,j) endif if (multiband_nir_input) then SW_nir_tot = sw_nir_dir(i,j) + sw_nir_dif(i,j) - else + elseif (total_sw_input) then SW_nir_tot = sw_total(i,j) - SW_vis_tot endif endif @@ -333,11 +344,13 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir !$OMP parallel do default(shared) private(SW_pen_tot) do j=js,je ; do i=is,ie SW_pen_tot = 0.0 - if (G%mask2dT(i,j) > 0.5) then ; if (multiband_vis_input) then + if (G%mask2dT(i,j) > 0.5) then + if (multiband_vis_input) then SW_pen_tot = SW_pen_frac_morel(chl_data(i,j)) * (sw_vis_dir(i,j) + sw_vis_dif(i,j)) - else + elseif (total_sw_input) then SW_pen_tot = SW_pen_frac_morel(chl_data(i,j)) * 0.5*sw_total(i,j) - endif ; endif + endif + endif do n=1,nbands optics%sw_pen_band(n,i,j) = Inv_nbands*sw_pen_tot @@ -395,7 +408,7 @@ function opacity_morel(chl_data) real :: opacity_morel !< The returned opacity [m-1] ! The following are coefficients for the optical model taken from Morel and - ! Antoine (1994). These coeficients represent a non uniform distribution of + ! Antoine (1994). These coefficients represent a non uniform distribution of ! chlorophyll-a through the water column. Other approaches may be more ! appropriate when using an interactive ecosystem model that predicts ! three-dimensional chl-a values. @@ -415,7 +428,7 @@ function SW_pen_frac_morel(chl_data) real :: SW_pen_frac_morel !< The returned penetrating shortwave fraction [nondim] ! The following are coefficients for the optical model taken from Morel and - ! Antoine (1994). These coeficients represent a non uniform distribution of + ! Antoine (1994). These coefficients represent a non uniform distribution of ! chlorophyll-a through the water column. Other approaches may be more ! appropriate when using an interactive ecosystem model that predicts ! three-dimensional chl-a values. @@ -496,7 +509,7 @@ function optics_nbands(optics) optics_nbands = optics%nbands end function optics_nbands -!> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inhereted +!> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inherited !! from GOLD) or throughout the water column. !! !! In addition, it causes all of the remaining SW radiation to be absorbed, provided that the total @@ -515,7 +528,7 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l real, dimension(SZI_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(max(1,nsw),SZI_(G),SZK_(GV)), intent(in) :: opacity_band !< Opacity in each band of penetrating !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. - !! The indicies are band, i, k. + !! The indices are band, i, k. type(optics_type), intent(in) :: optics !< An optics structure that has values of !! opacities and shortwave fluxes. integer, intent(in) :: j !< j-index to work on. @@ -548,7 +561,7 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l real, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: eps !< Small thickness that must remain in !! each layer, and which will not be !! subject to heating [H ~> m or kg m-2] - integer, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: ksort !< Density-sorted k-indicies. + integer, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: ksort !< Density-sorted k-indices. real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness [H ~> m or kg m-2]. real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer !! temperature [degC H ~> degC m or degC kg m-2] @@ -912,7 +925,7 @@ end subroutine sumSWoverBands -!> This routine initalizes the opacity module, including an optics_type. +!> This routine initializes the opacity module, including an optics_type. subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) type(time_type), target, intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -922,7 +935,7 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(opacity_CS) :: CS !< Opacity control struct + type(opacity_CS) :: CS !< Opacity control structure type(optics_type) :: optics !< An optics structure that has parameters !! set and arrays allocated here. ! Local variables @@ -1083,6 +1096,8 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) "The value to use for opacity over land. The default is "//& "10 m-1 - a value for muddy water.", units="m-1", default=10.0) + CS%warning_issued = .false. + if (.not.allocated(optics%opacity_band)) & allocate(optics%opacity_band(optics%nbands,isd:ied,jsd:jed,nz)) if (.not.allocated(optics%sw_pen_band)) & @@ -1106,7 +1121,7 @@ end subroutine opacity_init subroutine opacity_end(CS, optics) - type(opacity_CS) :: CS !< Opacity control struct + type(opacity_CS) :: CS !< Opacity control structure type(optics_type) :: optics !< An optics type structure that should be deallocated. if (allocated(CS%id_opacity)) & @@ -1125,7 +1140,7 @@ end subroutine opacity_end !! !! opacity_from_chl: !! In this routine, the Morel (modified) or Manizza (modified) -!! schemes use the "blue" band in the paramterizations to determine +!! schemes use the "blue" band in the parameterizations to determine !! the e-folding depth of the incoming shortwave attenuation. The red !! portion is lumped into the net heating at the surface. !! From 90739bea1bbf405f6d5381b174286493fc951bba Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 10 Dec 2021 10:12:23 -0500 Subject: [PATCH 15/73] Correct comments describing advect_tracer args Corrected the comments describing the optional arguments to advect_tracer and fixed a few spelling errors in comments. All answers are bitwise identical. --- src/core/MOM_CoriolisAdv.F90 | 2 +- src/tracer/MOM_tracer_advect.F90 | 16 +++++++++------- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 953d64c1f0..dde2cfc988 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -119,7 +119,7 @@ module MOM_CoriolisAdv !> Calculates the Coriolis and momentum advection contributions to the acceleration. subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv) - type(ocean_grid_type), intent(in) :: G !< Ocen grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 34c8dddf04..1ad6343cf8 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -34,7 +34,7 @@ module MOM_tracer_advect logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: usePPM !< If true, use PPM instead of PLM logical :: useHuynh !< If true, use the Huynh scheme for PPM interface values - type(group_pass_type) :: pass_uhr_vhr_t_hprev !< A structred used for group passes + type(group_pass_type) :: pass_uhr_vhr_t_hprev !< A structure used for group passes end type tracer_advect_CS !>@{ CPU time clocks @@ -63,18 +63,20 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & type(tracer_advect_CS), pointer :: CS !< control structure for module type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(in) :: h_prev_opt !< layer thickness before advection [H ~> m or kg m-2] + optional, intent(in) :: h_prev_opt !< Cell volume before advection [H L2 ~> m3 or kg] integer, optional, intent(in) :: max_iter_in !< The maximum number of iterations logical, optional, intent(in) :: x_first_in !< If present, indicate whether to update !! first in the x- or y-direction. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: uhr_out !< accumulated volume/mass flux through zonal face + optional, intent(out) :: uhr_out !< Remaining accumulated volume/mass flux through zonal face !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - optional, intent(out) :: vhr_out !< accumulated volume/mass flux through merid face + optional, intent(out) :: vhr_out !< Remaining accumulated volume/mass flux through meridional face !! [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: h_out !< layer thickness before advection [H ~> m or kg m-2] + optional, intent(out) :: h_out !< Cell volume after the transport that was done + !! by this call [H L2 ~> m3 or kg]. If all the transport + !! could be accommodated, this is close to h_end*G%areaT. type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -380,7 +382,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & CFL ! The absolute value of the advective upwind-cell CFL number [nondim]. real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. - real :: tiny_h ! The smallest numerically invertable thickness [H ~> m or kg m-2]. + real :: tiny_h ! The smallest numerically invertible thickness [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. logical :: do_i(SZIB_(G),SZJ_(G)) ! If true, work on given points. @@ -744,7 +746,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & CFL ! The absolute value of the advective upwind-cell CFL number [nondim]. real :: min_h ! The minimum thickness that can be realized during ! any of the passes [H ~> m or kg m-2]. - real :: tiny_h ! The smallest numerically invertable thickness [H ~> m or kg m-2]. + real :: tiny_h ! The smallest numerically invertible thickness [H ~> m or kg m-2]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. logical :: do_j_tr(SZJ_(G)) ! If true, calculate the tracer profiles. From 3364af1b8855a3c6a457e00decd0837481a1cc7c Mon Sep 17 00:00:00 2001 From: William Cooke Date: Mon, 6 Dec 2021 14:16:40 -0500 Subject: [PATCH 16/73] Update indexing of array passed to data_override. The arrays passed to data_overrride need to be sized as the compute domain. Added indices to pass to data_override. --- config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index d7c483ce49..09ba9e1156 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -1168,8 +1168,8 @@ subroutine apply_force_adjustments(G, US, CS, Time, forces) tempx_at_h(:,:) = 0.0 ; tempy_at_h(:,:) = 0.0 ! Either reads data or leaves contents unchanged overrode_x = .false. ; overrode_y = .false. - call data_override(G%Domain, 'taux_adj', tempx_at_h, Time, override=overrode_x, scale=Pa_conversion) - call data_override(G%Domain, 'tauy_adj', tempy_at_h, Time, override=overrode_y, scale=Pa_conversion) + call data_override(G%Domain, 'taux_adj', tempx_at_h(isc:iec,jsc:jec), Time, override=overrode_x, scale=Pa_conversion) + call data_override(G%Domain, 'tauy_adj', tempy_at_h(isc:iec,jsc:jec), Time, override=overrode_y, scale=Pa_conversion) if (overrode_x .or. overrode_y) then if (.not. (overrode_x .and. overrode_y)) call MOM_error(FATAL,"apply_flux_adjustments: "//& From 231913920d4625b2649f8d2302edfbb8276186a0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 7 Dec 2021 14:38:57 -0500 Subject: [PATCH 17/73] Correct out of bounds index (por_face_areaU) bug Corrected the expressionfs for the por_face_areaU arguments being passed to zonal_face_thickness to avoid the array out-of-bounds index errors highlighted in MOM6 issue #24. Also added comments noting where the por_face_area arrays should probably be included in the effective (relative) face thickness calculations that are later used for finding the vertically averaged accelerations by the barotropic solver. All answers and output are bitwise identical in cases that work, but this should avoid some run-time or compile-time errors with some compiler settings. --- src/core/MOM_continuity_PPM.F90 | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 15a6bf72a3..17d2f830c0 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -223,7 +223,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, por_face_are !! [H L2 T-1 ~> m3 s-1 or kg s-1]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. + type(continuity_PPM_CS), intent(in) :: CS !< This module's control structure. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), & @@ -512,10 +512,10 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, por_face_are if (set_BT_cont) then ; if (allocated(BT_cont%h_u)) then if (present(u_cor)) then call zonal_face_thickness(u_cor, h_in, h_L, h_R, BT_cont%h_u, dt, G, GV, US, LB, & - CS%vol_CFL, CS%marginal_faces, OBC, por_face_areaU(:,j,k), visc_rem_u) + CS%vol_CFL, CS%marginal_faces, OBC, por_face_areaU, visc_rem_u) else call zonal_face_thickness(u, h_in, h_L, h_R, BT_cont%h_u, dt, G, GV, US, LB, & - CS%vol_CFL, CS%marginal_faces, OBC, por_face_areaU(:,j,k), visc_rem_u) + CS%vol_CFL, CS%marginal_faces, OBC, por_face_areaU, visc_rem_u) endif endif ; endif @@ -672,9 +672,11 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, else ; h_u(I,j,k) = h_avg ; endif enddo ; enddo ; enddo if (present(visc_rem_u)) then + !### The expression setting h_u should also be multiplied by por_face_areaU in this case, + ! and in the two OBC cases below with visc_rem_u. !$OMP parallel do default(shared) do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh - h_u(I,j,k) = h_u(I,j,k) * visc_rem_u(I,j,k) + h_u(I,j,k) = h_u(I,j,k) * visc_rem_u(I,j,k) !### * por_face_areaU(I,j,k) enddo ; enddo ; enddo endif @@ -687,7 +689,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, if (OBC%segment(n)%direction == OBC_DIRECTION_E) then if (present(visc_rem_u)) then ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed - h_u(I,j,k) = h(i,j,k) * visc_rem_u(I,j,k) + h_u(I,j,k) = h(i,j,k) * visc_rem_u(I,j,k) !### * por_face_areaU(I,j,k) enddo enddo ; else ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed @@ -697,7 +699,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, else if (present(visc_rem_u)) then ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed - h_u(I,j,k) = h(i+1,j,k) * visc_rem_u(I,j,k) + h_u(I,j,k) = h(i+1,j,k) * visc_rem_u(I,j,k) !### * por_face_areaU(I,j,k) enddo enddo ; else ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed @@ -1495,9 +1497,11 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, enddo ; enddo ; enddo if (present(visc_rem_v)) then + !### This expression setting h_v should also be multiplied by por_face_areaU in this case, + ! and in the two OBC cases below with visc_rem_u. !$OMP parallel do default(shared) do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh - h_v(i,J,k) = h_v(i,J,k) * visc_rem_v(i,J,k) + h_v(i,J,k) = h_v(i,J,k) * visc_rem_v(i,J,k) !### * por_face_areaV(i,J,k) enddo ; enddo ; enddo endif @@ -1510,7 +1514,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, if (OBC%segment(n)%direction == OBC_DIRECTION_N) then if (present(visc_rem_v)) then ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied - h_v(i,J,k) = h(i,j,k) * visc_rem_v(i,J,k) + h_v(i,J,k) = h(i,j,k) * visc_rem_v(i,J,k) !### * por_face_areaV(i,J,k) enddo enddo ; else ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied @@ -1520,7 +1524,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, else if (present(visc_rem_v)) then ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied - h_v(i,J,k) = h(i,j+1,k) * visc_rem_v(i,J,k) + h_v(i,J,k) = h(i,j+1,k) * visc_rem_v(i,J,k) !### * por_face_areaV(i,J,k) enddo enddo ; else ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied From 05edb63da9676efdf2907232b547a1eb20cf15c4 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 10 Dec 2021 15:39:04 -0500 Subject: [PATCH 18/73] (*)Offline tracer read bug fix Corrected bugs in the offline tracer code that were preventing it from reproducing across processor counts (and perhaps working sensibly at all). All answers and output in the MOM6-examples regression suite are bitwise identical. Although answers with the offline tracer code will change because of the bug fix, because of some bugs that were fixed in another recent commit, it was previously impossible to have run the offline tracer cases at all. --- src/tracer/MOM_offline_aux.F90 | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index af8b422238..d002393cbb 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -673,21 +673,23 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ vhtr(:,:,:) = 0.0 ! Time-summed fields call MOM_read_vector(sum_file, 'uhtr_sum', 'vhtr_sum', uhtr(:,:,1:nk_input), & - vhtr(:,:,1:nk_input), G%Domain, timelevel=ridx_sum) + vhtr(:,:,1:nk_input), G%Domain, timelevel=ridx_sum, & + scale=GV%kg_m2_to_H) call MOM_read_data(snap_file, 'h_end', h_end(:,:,1:nk_input), G%Domain, & timelevel=ridx_snap,position=CENTER) call MOM_read_data(mean_file, 'temp', temp_mean(:,:,1:nk_input), G%Domain, & timelevel=ridx_sum,position=CENTER) call MOM_read_data(mean_file, 'salt', salt_mean(:,:,1:nk_input), G%Domain, & timelevel=ridx_sum,position=CENTER) - endif - do j=js,je ; do i=is,ie - if (G%mask2dT(i,j)>0.) then - temp_mean(:,:,nk_input:nz) = temp_mean(i,j,nk_input) - salt_mean(:,:,nk_input:nz) = salt_mean(i,j,nk_input) - endif - enddo ; enddo + ! Fill temperature and salinity downward from the deepest input data. + do k=nk_input+1,nz ; do j=js,je ; do i=is,ie + if (G%mask2dT(i,j)>0.) then + temp_mean(i,j,k) = temp_mean(i,j,nk_input) + salt_mean(i,j,k) = salt_mean(i,j,nk_input) + endif + enddo ; enddo ; enddo + endif ! Check if reading vertical diffusivities or entrainment fluxes call MOM_read_data( mean_file, 'Kd_interface', Kd(:,:,1:nk_input+1), G%Domain, & From fcfd238ab3e4171a905fa4c1bd2f46ef74e4b456 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 10 Dec 2021 20:52:50 -0500 Subject: [PATCH 19/73] +Refactored and rescaled the offline tracer code Substantially refactored the offline tracer code. This refactoring includes adding grid and unit_scale_type arguments to several routines related to the offline tracer code. An offline tracer advection test case is now consistent across processor layouts and pass the dimensional rescaling tests (including the chksums in debug mode), and there are comments describing all the real variables and their dimensions in the offline tracer routines. All answers and output are bitwise identical. --- config_src/drivers/solo_driver/MOM_driver.F90 | 3 +- src/ALE/MOM_ALE.F90 | 16 +- src/core/MOM.F90 | 43 +- src/tracer/MOM_offline_aux.F90 | 289 ++++---- src/tracer/MOM_offline_main.F90 | 699 +++++++++--------- 5 files changed, 544 insertions(+), 506 deletions(-) diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index ebf3e5a43d..1b88f1ce36 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -332,7 +332,8 @@ program MOM_main "The default value is given by DT.", units="s", default=dt) if (offline_tracer_mode) then call get_param(param_file, mod_name, "DT_OFFLINE", dt_forcing, & - "Time step for the offline time step") + "Length of time between reading in of input fields", & + units='s', fail_if_missing=.true.) dt = dt_forcing endif ntstep = MAX(1,ceiling(dt_forcing/dt - 0.001)) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 70e152932c..9aa01738b6 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -459,21 +459,21 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC) type(ALE_CS), pointer :: CS !< Regridding parameters and options type(ocean_grid_type), intent(in ) :: G !< Ocean grid informations type(verticalGrid_type), intent(in ) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thicknesses + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure type(tracer_registry_type), pointer :: Reg !< Tracer registry structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Zonal mass fluxes - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Meridional mass fluxes - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kd !< Input diffusivites + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Zonal mass fluxes [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Meridional mass fluxes [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kd !< Input diffusivites [Z2 T-1 ~> m2 s-1] logical, intent(in ) :: debug !< If true, then turn checksums type(ocean_OBC_type), pointer :: OBC !< Open boundary structure ! Local variables integer :: nk, i, j, k, isc, iec, jsc, jec - real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: h_new ! Layer thicknesses after regridding + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: h_new ! Layer thicknesses after regridding [H ~> m or kg m-2] real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions - real, dimension(SZK_(GV)) :: h_src - real, dimension(SZK_(GV)) :: h_dest, uh_dest - real, dimension(SZK_(GV)) :: temp_vec + real, dimension(SZK_(GV)) :: h_src ! Source grid thicknesses at velocity points [H ~> m or kg m-2] + real, dimension(SZK_(GV)) :: h_dest ! Destination grid thicknesses at velocity points [H ~> m or kg m-2] + real, dimension(SZK_(GV)) :: temp_vec ! Transports on the destination grid [H L2 ~> m3 or kg] nk = GV%ke; isc = G%isc; iec = G%iec; jsc = G%jsc; jec = G%jec dzRegrid(:,:,:) = 0.0 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 0e036d9d8f..ffce665967 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1214,7 +1214,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G%HI, haloshift=1) if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G%HI, haloshift=1) if (associated(CS%tv%frazil)) call hchksum(CS%tv%frazil, "Pre-advection frazil", G%HI, haloshift=0, & - scale=G%US%Q_to_J_kg*G%US%RZ_to_kg_m2) + scale=US%Q_to_J_kg*US%RZ_to_kg_m2) if (associated(CS%tv%salt_deficit)) call hchksum(CS%tv%salt_deficit, & "Pre-advection salt deficit", G%HI, haloshift=0, scale=US%RZ_to_kg_m2) ! call MOM_thermo_chksum("Pre-advection ", CS%tv, G, US) @@ -1445,7 +1445,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1) if (associated(tv%S)) call hchksum(tv%S, "Post-diabatic S", G%HI, haloshift=1) if (associated(tv%frazil)) call hchksum(tv%frazil, "Post-diabatic frazil", G%HI, haloshift=0, & - scale=G%US%Q_to_J_kg*G%US%RZ_to_kg_m2) + scale=US%Q_to_J_kg*US%RZ_to_kg_m2) if (associated(tv%salt_deficit)) call hchksum(tv%salt_deficit, & "Post-diabatic salt deficit", G%HI, haloshift=0, scale=US%RZ_to_kg_m2) ! call MOM_thermo_chksum("Post-diabatic ", tv, G, US) @@ -1490,7 +1490,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS type(forcing), intent(inout) :: fluxes !< pointers to forcing fields type(surface), intent(inout) :: sfc_state !< surface ocean state type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< time interval + real, intent(in) :: time_interval !< time interval [s] type(MOM_control_struct), intent(inout) :: CS !< control structure from initialize_MOM ! Local pointers @@ -1568,17 +1568,17 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! call update_transport_from_files(G, GV, CS%offline_CSp, h_end, eatr, ebtr, uhtr, vhtr, & ! CS%tv%T, CS%tv%S, fluxes, CS%use_ALE_algorithm) ! call update_transport_from_arrays(CS%offline_CSp) - call update_offline_fields(CS%offline_CSp, CS%h, fluxes, CS%use_ALE_algorithm) + call update_offline_fields(CS%offline_CSp, G, GV, US, CS%h, fluxes, CS%use_ALE_algorithm) ! Apply any fluxes into the ocean call offline_fw_fluxes_into_ocean(G, GV, CS%offline_CSp, fluxes, CS%h) if (.not.CS%diabatic_first) then - call offline_advection_ale(fluxes, Time_start, time_interval, CS%offline_CSp, id_clock_ALE, & - CS%h, uhtr, vhtr, converged=adv_converged) + call offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, CS%offline_CSp, & + id_clock_ALE, CS%h, uhtr, vhtr, converged=adv_converged) ! Redistribute any remaining transport - call offline_redistribute_residual(CS%offline_CSp, CS%h, uhtr, vhtr, adv_converged) + call offline_redistribute_residual(CS%offline_CSp, G, GV, US, CS%h, uhtr, vhtr, adv_converged) ! Perform offline diffusion if requested if (.not. skip_diffusion) then @@ -1589,23 +1589,24 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call calc_slope_functions(CS%h, CS%tv, dt_offline, G, GV, US, CS%VarMix, OBC=CS%OBC) endif call tracer_hordiff(CS%h, dt_offline, CS%MEKE, CS%VarMix, G, GV, US, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif endif endif ! The functions related to column physics of tracers is performed separately in ALE mode if (do_vertical) then - call offline_diabatic_ale(fluxes, Time_start, Time_end, CS%offline_CSp, CS%h, eatr, ebtr) + call offline_diabatic_ale(fluxes, Time_start, Time_end, G, GV, US, CS%offline_CSp, & + CS%h, eatr, ebtr) endif ! Last thing that needs to be done is the final ALE remapping if (last_iter) then if (CS%diabatic_first) then - call offline_advection_ale(fluxes, Time_start, time_interval, CS%offline_CSp, id_clock_ALE, & - CS%h, uhtr, vhtr, converged=adv_converged) + call offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, CS%offline_CSp, & + id_clock_ALE, CS%h, uhtr, vhtr, converged=adv_converged) ! Redistribute any remaining transport and perform the remaining advection - call offline_redistribute_residual(CS%offline_CSp, CS%h, uhtr, vhtr, adv_converged) + call offline_redistribute_residual(CS%offline_CSp, G, GV, US, CS%h, uhtr, vhtr, adv_converged) ! Perform offline diffusion if requested if (.not. skip_diffusion) then if (CS%VarMix%use_variable_mixing) then @@ -1625,7 +1626,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call offline_fw_fluxes_out_ocean(G, GV, CS%offline_CSp, fluxes, CS%h) ! These diagnostic can be used to identify which grid points did not converge within ! the specified number of advection sub iterations - call post_offline_convergence_diags(CS%offline_CSp, CS%h, h_end, uhtr, vhtr) + call post_offline_convergence_diags(G, GV, CS%offline_CSp, CS%h, h_end, uhtr, vhtr) ! Call ALE one last time to make sure that tracers are remapped onto the layer thicknesses ! stored from the forward run @@ -1644,9 +1645,9 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call MOM_error(FATAL, & "For offline tracer mode in a non-ALE configuration, dt_offline must equal time_interval") endif - call update_offline_fields(CS%offline_CSp, CS%h, fluxes, CS%use_ALE_algorithm) - call offline_advection_layer(fluxes, Time_start, time_interval, CS%offline_CSp, & - CS%h, eatr, ebtr, uhtr, vhtr) + call update_offline_fields(CS%offline_CSp, G, GV, US, CS%h, fluxes, CS%use_ALE_algorithm) + call offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, CS%offline_CSp, & + CS%h, eatr, ebtr, uhtr, vhtr) ! Perform offline diffusion if requested if (.not. skip_diffusion) then call tracer_hordiff(h_end, dt_offline, CS%MEKE, CS%VarMix, G, GV, US, & @@ -2791,10 +2792,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Setup some initial parameterizations and also assign some of the subtypes call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV, US) call insert_offline_main( CS=CS%offline_CSp, ALE_CSp=CS%ALE_CSp, diabatic_CSp=CS%diabatic_CSp, & - diag=CS%diag, OBC=CS%OBC, tracer_adv_CSp=CS%tracer_adv_CSp, & - tracer_flow_CSp=CS%tracer_flow_CSp, tracer_Reg=CS%tracer_Reg, & + diag=CS%diag, OBC=CS%OBC, tracer_adv_CSp=CS%tracer_adv_CSp, & + tracer_flow_CSp=CS%tracer_flow_CSp, tracer_Reg=CS%tracer_Reg, & tv=CS%tv, x_before_y=(MODULO(first_direction,2)==0), debug=CS%debug ) - call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp) + call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp, GV, US) endif !--- set up group pass for u,v,T,S and h. pass_uv_T_S_h also is used in step_MOM @@ -3506,7 +3507,7 @@ subroutine extract_surface_state(CS, sfc_state_in) 'Extreme surface sfc_state detected: i=',ig,'j=',jg, & 'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), & 'x=',G%gridLonT(ig), 'y=',G%gridLatT(jg), & - 'D=',CS%US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',CS%US%Z_to_m*sfc_state%sea_lev(i,j), & + 'D=',US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',US%Z_to_m*sfc_state%sea_lev(i,j), & 'SST=',sfc_state%SST(i,j), 'SSS=',sfc_state%SSS(i,j), & 'U-=',US%L_T_to_m_s*sfc_state%u(I-1,j), 'U+=',US%L_T_to_m_s*sfc_state%u(I,j), & 'V-=',US%L_T_to_m_s*sfc_state%v(i,J-1), 'V+=',US%L_T_to_m_s*sfc_state%v(i,J) @@ -3515,7 +3516,7 @@ subroutine extract_surface_state(CS, sfc_state_in) 'Extreme surface sfc_state detected: i=',ig,'j=',jg, & 'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), & 'x=',G%gridLonT(i), 'y=',G%gridLatT(j), & - 'D=',CS%US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',CS%US%Z_to_m*sfc_state%sea_lev(i,j), & + 'D=',US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',US%Z_to_m*sfc_state%sea_lev(i,j), & 'U-=',US%L_T_to_m_s*sfc_state%u(I-1,j), 'U+=',US%L_T_to_m_s*sfc_state%u(I,j), & 'V-=',US%L_T_to_m_s*sfc_state%v(i,J-1), 'V+=',US%L_T_to_m_s*sfc_state%v(i,J) endif diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index d002393cbb..b370dd6bb4 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -15,6 +15,7 @@ module MOM_offline_aux use MOM_io, only : MOM_read_data, MOM_read_vector, CENTER use MOM_opacity, only : optics_type use MOM_time_manager, only : time_type, operator(-) +use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : vertvisc_type use MOM_verticalGrid, only : verticalGrid_type use astronomy_mod, only : orbital_time, diurnal_solar, daily_mean_solar @@ -34,43 +35,42 @@ module MOM_offline_aux public offline_add_diurnal_sw #include "MOM_memory.h" -#include "version_variable.h" contains !> This updates thickness based on the convergence of horizontal mass fluxes !! NOTE: Only used in non-ALE mode subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) - type(ocean_grid_type), pointer :: G !< ocean grid structure - type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: uhtr !< Accumulated mass flux through zonal face [kg] + intent(in) :: uhtr !< Accumulated mass flux through zonal face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: vhtr !< Accumulated mass flux through meridional face [kg] + intent(in) :: vhtr !< Accumulated mass flux through meridional face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h_pre !< Previous layer thicknesses [kg m-2]. + intent(in) :: h_pre !< Previous layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h_new !< Updated layer thicknesses [kg m-2]. + intent(inout) :: h_new !< Updated layer thicknesses [H ~> m or kg m-2] ! Local variables integer :: i, j, k, m, is, ie, js, je, nz ! Set index-related variables for fields on T-grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - do k = 1, nz + do k=1,nz do i=is-1,ie+1 ; do j=js-1,je+1 - h_new(i,j,k) = max(0.0, G%US%L_to_m**2*G%areaT(i,j)*h_pre(i,j,k) + & - ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) + h_new(i,j,k) = max(0.0, G%areaT(i,j)*h_pre(i,j,k) + & + ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) ! In the case that the layer is now dramatically thinner than it was previously, ! add a bit of mass to avoid truncation errors. This will lead to ! non-conservation of tracers h_new(i,j,k) = h_new(i,j,k) + & - max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%US%L_to_m**2*G%areaT(i,j)*h_pre(i,j,k)) + max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) ! Convert back to thickness - h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) + h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) enddo ; enddo enddo @@ -79,19 +79,19 @@ end subroutine update_h_horizontal_flux !> Updates layer thicknesses due to vertical mass transports !! NOTE: Only used in non-ALE configuration subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) - type(ocean_grid_type), pointer :: G !< ocean grid structure - type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: ea !< Mass of fluid entrained from the layer - !! above within this timestep [kg m-2] + !! above within this timestep [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: eb !< Mass of fluid entrained from the layer - !! below within this timestep [kg m-2] + !! below within this timestep [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_pre !< Layer thicknesses at the end of the previous - !! step [kg m-2]. + !! step [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h_new !< Updated layer thicknesses [kg m-2]. + intent(inout) :: h_new !< Updated layer thicknesses [H ~> m or kg m-2] ! Local variables integer :: i, j, k, m, is, ie, js, je, nz @@ -101,30 +101,21 @@ subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) ! Update h_new with convergence of vertical mass transports do j=js-1,je+1 do i=is-1,ie+1 - ! Top layer h_new(i,j,1) = max(0.0, h_pre(i,j,1) + (eb(i,j,1) - ea(i,j,2) + ea(i,j,1) )) - h_new(i,j,1) = h_new(i,j,1) + & - max(0.0, 1.0e-13*h_new(i,j,1) - h_pre(i,j,1)) + h_new(i,j,1) = h_new(i,j,1) + max(0.0, 1.0e-13*h_new(i,j,1) - h_pre(i,j,1)) ! Bottom layer -! h_new(i,j,nz) = h_pre(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)+eb(i,j,nz)) h_new(i,j,nz) = max(0.0, h_pre(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)+eb(i,j,nz))) - h_new(i,j,nz) = h_new(i,j,nz) + & - max(0.0, 1.0e-13*h_new(i,j,nz) - h_pre(i,j,nz)) - + h_new(i,j,nz) = h_new(i,j,nz) + max(0.0, 1.0e-13*h_new(i,j,nz) - h_pre(i,j,nz)) enddo ! Interior layers do k=2,nz-1 ; do i=is-1,ie+1 - h_new(i,j,k) = max(0.0, h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & - (eb(i,j,k) - ea(i,j,k+1)))) - h_new(i,j,k) = h_new(i,j,k) + & - max(0.0, 1.0e-13*h_new(i,j,k) - h_pre(i,j,k)) - + (eb(i,j,k) - ea(i,j,k+1)))) + h_new(i,j,k) = h_new(i,j,k) + max(0.0, 1.0e-13*h_new(i,j,k) - h_pre(i,j,k)) enddo ; enddo - enddo end subroutine update_h_vertical_flux @@ -132,35 +123,39 @@ end subroutine update_h_vertical_flux !> This routine limits the mass fluxes so that the a layer cannot be completely depleted. !! NOTE: Only used in non-ALE mode subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) - type(ocean_grid_type), pointer :: G !< ocean grid structure - type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: uh !< Mass flux through zonal face [kg] + intent(inout) :: uh !< Mass flux through zonal face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: vh !< Mass flux through meridional face [kg] + intent(inout) :: vh !< Mass flux through meridional face [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< Mass of fluid entrained from the layer - !! above within this timestep [kg m-2] + !! above within this timestep [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: eb !< Mass of fluid entrained from the layer - !! below within this timestep [kg m-2] + !! below within this timestep [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_pre !< Layer thicknesses at the end of the previous - !! step [kg m-2]. + !! step [H ~> m or kg m-2] ! Local variables integer :: i, j, k, m, is, ie, js, je, nz - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: top_flux, bottom_flux - real :: pos_flux, hvol, h_neglect, scale_factor, max_off_cfl + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: top_flux ! Net fluxes through the layer top [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: bottom_flux ! Net fluxes through the layer bottom [H ~> m or kg m-2] + real :: pos_flux ! Net flux out of cell [H L2 ~> m3 or kg m-2] + real :: hvol ! Cell volume [H L2 ~> m3 or kg m-2] + real :: scale_factor ! A nondimensional rescaling factor between 0 and 1 [nondim] + real :: max_off_cfl ! The maximum permitted fraction that can leave in a timestep [nondim] - max_off_cfl =0.5 + max_off_cfl = 0.5 ! In this subroutine, fluxes out of the box are scaled away if they deplete ! the layer, note that we define the positive direction as flux out of the box. ! Hence, uh(I-1) is multipled by negative one, but uh(I) is not ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! Calculate top and bottom fluxes from ea and eb. Note the explicit negative signs ! to enforce the positive out convention @@ -170,7 +165,7 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) bottom_flux(i,j,k) = -(eb(i,j,k)-ea(i,j,k+1)) enddo ; enddo - do k=2, nz-1 ; do j=js-1,je+1 ; do i=is-1,ie+1 + do k=2,nz-1 ; do j=js-1,je+1 ; do i=is-1,ie+1 top_flux(i,j,k) = -(ea(i,j,k)-eb(i,j,k-1)) bottom_flux(i,j,k) = -(eb(i,j,k)-ea(i,j,k+1)) enddo ; enddo ; enddo @@ -184,15 +179,15 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) ! Calculate sum of positive fluxes (negatives applied to enforce convention) ! in a given cell and scale it back if it would deplete a layer - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 - hvol = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) + hvol = h_pre(i,j,k) * G%areaT(i,j) pos_flux = max(0.0,-uh(I-1,j,k)) + max(0.0, -vh(i,J-1,k)) + & - max(0.0, uh(I,j,k)) + max(0.0, vh(i,J,k)) + & - max(0.0, top_flux(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)) + max(0.0, bottom_flux(i,j,k)*G%US%L_to_m**2*G%areaT(i,j)) + max(0.0, uh(I,j,k)) + max(0.0, vh(i,J,k)) + & + max(0.0, top_flux(i,j,k)*G%areaT(i,j)) + max(0.0, bottom_flux(i,j,k)*G%areaT(i,j)) if (pos_flux>hvol .and. pos_flux>0.0) then - scale_factor = ( hvol )/pos_flux*max_off_cfl + scale_factor = (hvol / pos_flux)*max_off_cfl else ! Don't scale scale_factor = 1.0 endif @@ -226,7 +221,7 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) ea(i,j,k) = ea(i,j,k)*scale_factor eb(i,j,k-1) = eb(i,j,k-1)*scale_factor endif - if (bottom_flux(i,j,k)>0.0) eb(i,j,k)=eb(i,j,k)*scale_factor + if (bottom_flux(i,j,k)>0.0) eb(i,j,k) = eb(i,j,k)*scale_factor endif enddo ; enddo ; enddo @@ -235,21 +230,22 @@ end subroutine limit_mass_flux_3d !> In the case where offline advection has failed to converge, redistribute the u-flux !! into remainder of the water column as a barotropic equivalent subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) - type(ocean_grid_type), pointer :: G !< ocean grid structure - type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure + type(ocean_grid_type), intent(in ) :: G !< ocean grid structure + type(verticalGrid_type), intent(in ) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in ) :: hvol !< Mass of water in the cells at the end - !! of the previous timestep [kg] + !! of the previous timestep [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: uh !< Zonal mass transport within a timestep [kg] + intent(inout) :: uh !< Zonal mass transport within a timestep [H L2 ~> m3 or kg] - real, dimension(SZIB_(G),SZK_(GV)) :: uh2d - real, dimension(SZIB_(G)) :: uh2d_sum - real, dimension(SZI_(G),SZK_(GV)) :: h2d - real, dimension(SZI_(G)) :: h2d_sum + ! Local variables + real, dimension(SZIB_(G),SZK_(GV)) :: uh2d ! A 2-d slice of transports [H L2 ~> m3 or kg] + real, dimension(SZIB_(G)) :: uh2d_sum ! Vertically summed transports [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZK_(GV)) :: h2d ! A 2-d slice of cell volumes [H L2 ~> m3 or kg] + real, dimension(SZI_(G)) :: h2d_sum ! Vertically summed cell volumes [H L2 ~> m3 or kg] + real :: uh_neglect ! A negligible transport [H L2 ~> m3 or kg] integer :: i, j, k, m, is, ie, js, je, nz - real :: uh_neglect ! Set index-related variables for fields on T-grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -269,7 +265,7 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) if (hvol(i,j,k)>0.) then h2d_sum(i) = h2d_sum(i) + h2d(i,k) else - h2d(i,k) = GV%H_subroundoff + h2d(i,k) = GV%H_subroundoff * 1.0*G%US%m_to_L**2 !### Change to G%areaT(i,j) endif enddo ; enddo @@ -291,10 +287,11 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) endif ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - uh_neglect = GV%Angstrom_H*G%US%L_to_m**2 * min(G%areaT(i,j), G%areaT(i+1,j)) + uh_neglect = GV%Angstrom_H * min(G%areaT(i,j), G%areaT(i+1,j)) + ! ### This test may not work if GV%Angstrom_H is set to 0. + ! Instead try the max of this and ~roundoff compared with absolute transports? if ( abs(sum(uh2d(I,:))-uh2d_sum(I)) > uh_neglect) & - call MOM_error(WARNING,"Column integral of uh does not match after "//& - "barotropic redistribution") + call MOM_error(WARNING, "Column integral of uh does not match after barotropic redistribution") enddo do k=1,nz ; do i=is-1,ie @@ -306,21 +303,22 @@ end subroutine distribute_residual_uh_barotropic !> Redistribute the v-flux as a barotropic equivalent subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) - type(ocean_grid_type), pointer :: G !< ocean grid structure - type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure + type(ocean_grid_type), intent(in ) :: G !< ocean grid structure + type(verticalGrid_type), intent(in ) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in ) :: hvol !< Mass of water in the cells at the end - !! of the previous timestep [kg] + !! of the previous timestep [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: vh !< Meridional mass transport within a timestep [kg] + intent(inout) :: vh !< Meridional mass transport within a timestep [H L2 ~> m3 or kg] - real, dimension(SZJB_(G),SZK_(GV)) :: vh2d - real, dimension(SZJB_(G)) :: vh2d_sum - real, dimension(SZJ_(G),SZK_(GV)) :: h2d - real, dimension(SZJ_(G)) :: h2d_sum + ! Local variables + real, dimension(SZJB_(G),SZK_(GV)) :: vh2d ! A 2-d slice of transports [H L2 ~> m3 or kg] + real, dimension(SZJB_(G)) :: vh2d_sum ! Vertically summed transports [H L2 ~> m3 or kg] + real, dimension(SZJ_(G),SZK_(GV)) :: h2d ! A 2-d slice of cell volumes [H L2 ~> m3 or kg] + real, dimension(SZJ_(G)) :: h2d_sum ! Vertically summed cell volumes [H L2 ~> m3 or kg] + real :: vh_neglect ! A negligible transport [H L2 ~> m3 or kg] integer :: i, j, k, m, is, ie, js, je, nz - real :: vh_neglect ! Set index-related variables for fields on T-grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -340,7 +338,7 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) if (hvol(i,j,k)>0.) then h2d_sum(j) = h2d_sum(j) + h2d(j,k) else - h2d(j,k) = GV%H_subroundoff + h2d(j,k) = GV%H_subroundoff * 1.0*G%US%m_to_L**2 !### Change to G%areaT(i,j) endif enddo ; enddo @@ -361,7 +359,9 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) endif ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - vh_neglect = GV%Angstrom_H*G%US%L_to_m**2 * min(G%areaT(i,j), G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H * min(G%areaT(i,j), G%areaT(i,j+1)) + ! ### This test may not work if GV%Angstrom_H is set to 0. + ! Instead try the max of this and ~roundoff compared with absolute transports? if ( abs(sum(vh2d(J,:))-vh2d_sum(J)) > vh_neglect) then call MOM_error(WARNING,"Column integral of vh does not match after "//& "barotropic redistribution") @@ -379,19 +379,21 @@ end subroutine distribute_residual_vh_barotropic !> In the case where offline advection has failed to converge, redistribute the u-flux !! into layers above subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) - type(ocean_grid_type), pointer :: G !< ocean grid structure - type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure + type(ocean_grid_type), intent(in ) :: G !< ocean grid structure + type(verticalGrid_type), intent(in ) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in ) :: hvol !< Mass of water in the cells at the end - !! of the previous timestep [kg] + !! of the previous timestep [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: uh !< Zonal mass transport within a timestep [kg] + intent(inout) :: uh !< Zonal mass transport within a timestep [H L2 ~> m3 or kg] - real, dimension(SZIB_(G),SZK_(GV)) :: uh2d - real, dimension(SZI_(G),SZK_(GV)) :: h2d + ! Local variables + real, dimension(SZIB_(G),SZK_(GV)) :: uh2d ! A slice of transports [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZK_(GV)) :: h2d ! A slice of updated cell volumes [H L2 ~> m3 or kg] - real :: uh_neglect, uh_remain, uh_add, uh_sum, uh_col, uh_max - real :: hup, hdown, hlos, min_h + real :: uh_neglect, uh_remain, uh_add, uh_sum, uh_col, uh_max ! Transports [H L2 ~> m3 or kg] + real :: hup, hlos ! Various cell volumes [H L2 ~> m3 or kg] + real :: min_h ! A minimal layer thickness [H ~> m or kg m-2] integer :: i, j, k, m, is, ie, js, je, nz, k_rev ! Set index-related variables for fields on T-grid @@ -406,7 +408,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) enddo ; enddo do k=1,nz ; do i=is-1,ie+1 ! Subtract just a little bit of thickness to avoid roundoff errors - h2d(i,k) = hvol(i,j,k)-min_h*G%US%L_to_m**2*G%areaT(i,j) + h2d(i,k) = hvol(i,j,k) - min_h * G%areaT(i,j) enddo ; enddo do i=is-1,ie @@ -457,10 +459,9 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - uh_neglect = GV%Angstrom_H*G%US%L_to_m**2 * min(G%areaT(i,j), G%areaT(i+1,j)) - if (abs(uh_col - sum(uh2d(I,:)))>uh_neglect) then - call MOM_error(WARNING,"Column integral of uh does not match after "//& - "upwards redistribution") + uh_neglect = GV%Angstrom_H * min(G%areaT(i,j), G%areaT(i+1,j)) + if (abs(uh_col - sum(uh2d(I,:))) > uh_neglect) then + call MOM_error(WARNING,"Column integral of uh does not match after upwards redistribution") endif enddo ! i-loop @@ -475,21 +476,23 @@ end subroutine distribute_residual_uh_upwards !> In the case where offline advection has failed to converge, redistribute the u-flux !! into layers above subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) - type(ocean_grid_type), pointer :: G !< ocean grid structure - type(verticalGrid_type), pointer :: GV !< ocean vertical grid structure + type(ocean_grid_type), intent(in ) :: G !< ocean grid structure + type(verticalGrid_type), intent(in ) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in ) :: hvol !< Mass of water in the cells at the end - !! of the previous timestep [kg] + !! of the previous timestep [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: vh !< Meridional mass transport within a timestep [kg] - - real, dimension(SZJB_(G),SZK_(GV)) :: vh2d - real, dimension(SZJB_(G)) :: vh2d_sum - real, dimension(SZJ_(G),SZK_(GV)) :: h2d - real, dimension(SZJ_(G)) :: h2d_sum + intent(inout) :: vh !< Meridional mass transport within a timestep [H L2 ~> m3 or kg] - real :: vh_neglect, vh_remain, vh_col, vh_sum - real :: hup, hlos, min_h + ! Local variables + real, dimension(SZJB_(G),SZK_(GV)) :: vh2d ! A slice of transports [H L2 ~> m3 or kg] + real, dimension(SZJB_(G)) :: vh2d_sum ! Summed transports [H L2 ~> m3 or kg] + real, dimension(SZJ_(G),SZK_(GV)) :: h2d ! A slice of updated cell volumes [H L2 ~> m3 or kg] + real, dimension(SZJ_(G)) :: h2d_sum ! Summed cell volumes [H L2 ~> m3 or kg] + + real :: vh_neglect, vh_remain, vh_col, vh_sum ! Transports [H L2 ~> m3 or kg] + real :: hup, hlos ! Various cell volumes [H L2 ~> m3 or kg] + real :: min_h ! A minimal layer thickness [H ~> m or kg m-2] integer :: i, j, k, m, is, ie, js, je, nz, k_rev ! Set index-related variables for fields on T-grid @@ -503,7 +506,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) vh2d(J,k) = vh(i,J,k) enddo ; enddo do k=1,nz ; do j=js-1,je+1 - h2d(j,k) = hvol(i,j,k)-min_h*G%US%L_to_m**2*G%areaT(i,j) + h2d(j,k) = hvol(i,j,k) - min_h * G%areaT(i,j) enddo ; enddo do j=js-1,je @@ -555,7 +558,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - vh_neglect = GV%Angstrom_H*G%US%L_to_m**2 * min(G%areaT(i,j), G%areaT(i,j+1)) + vh_neglect = GV%Angstrom_H * min(G%areaT(i,j), G%areaT(i,j+1)) if ( ABS(vh_col-SUM(vh2d(J,:))) > vh_neglect) then call MOM_error(WARNING,"Column integral of vh does not match after "//& "upwards redistribution") @@ -577,12 +580,20 @@ subroutine offline_add_diurnal_SW(fluxes, G, Time_start, Time_end) type(time_type), intent(in) :: Time_start !< The start time for this step. type(time_type), intent(in) :: Time_end !< The ending time for this step. - real :: diurnal_factor, time_since_ae, rad - real :: fracday_dt, fracday_day - real :: cosz_day, cosz_dt, rrsun_day, rrsun_dt - type(time_type) :: dt_here - - integer :: i, j, k, i2, j2, isc, iec, jsc, jec, i_off, j_off + real :: diurnal_factor ! A scaling factor to insert a synthetic diurnal cycle [nondim] + real :: time_since_ae ! Time since the autumnal equinox expressed as a fraction of a year times 2 pi [nondim] + real :: rad ! A conversion factor from degrees to radians = pi/180 degrees [nondim] + real :: fracday_dt ! Daylight fraction averaged over a timestep [nondim] + real :: fracday_day ! Daylight fraction averaged over a day [nondim] + real :: cosz_day ! Cosine of the solar zenith angle averaged over a day [nondim] + real :: cosz_dt ! Cosine of the solar zenith angle averaged over a timestep [nondim] + real :: rrsun_day ! Earth-Sun distance (r) relative to the semi-major axis of + ! the orbital ellipse averaged over a day [nondim] + real :: rrsun_dt ! Earth-Sun distance (r) relative to the semi-major axis of + ! the orbital ellipse averaged over a timestep [nondim] + type(time_type) :: dt_here ! The time increment covered by this call + + integer :: i, j, i2, j2, isc, iec, jsc, jec, i_off, j_off isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec i_off = LBOUND(fluxes%sens,1) - G%isc ; j_off = LBOUND(fluxes%sens,2) - G%jsc @@ -593,10 +604,8 @@ subroutine offline_add_diurnal_SW(fluxes, G, Time_start, Time_end) dt_here = Time_end - Time_start rad = acos(-1.)/180. -!$OMP parallel do default(none) shared(isc,iec,jsc,jec,G,rad,Time_start,dt_here,time_since_ae, & -!$OMP fluxes,i_off,j_off) & -!$OMP private(i,j,i2,j2,k,cosz_dt,fracday_dt,rrsun_dt, & -!$OMP fracday_day,cosz_day,rrsun_day,diurnal_factor) + !$OMP parallel do default(shared) private(i,j,i2,j2,cosz_dt,fracday_dt,rrsun_dt, & + !$OMP fracday_day,cosz_day,rrsun_day,diurnal_factor) do j=jsc,jec ; do i=isc,iec ! Per Rick Hemler: ! Call diurnal_solar with dtime=dt_here to get cosz averaged over dt_here. @@ -622,31 +631,32 @@ end subroutine offline_add_diurnal_sw !> Controls the reading in 3d mass fluxes, diffusive fluxes, and other fields stored !! in a previous integration of the online model -subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_file, surf_file, h_end, & - uhtr, vhtr, temp_mean, salt_mean, mld, Kd, fluxes, ridx_sum, ridx_snap, read_mld, read_sw, & - read_ts_uvh, do_ale_in) +subroutine update_offline_from_files(G, GV, US, nk_input, mean_file, sum_file, snap_file, & + surf_file, h_end, uhtr, vhtr, temp_mean, salt_mean, mld, Kd, fluxes, & + ridx_sum, ridx_snap, read_mld, read_sw, read_ts_uvh, do_ale_in) type(ocean_grid_type), intent(inout) :: G !< Horizontal grid type type(verticalGrid_type), intent(in ) :: GV !< Vertical grid type + type(unit_scale_type), intent(in ) :: US !< A dimensional unit scaling type integer, intent(in ) :: nk_input !< Number of levels in input file character(len=*), intent(in ) :: mean_file !< Name of file with averages fields character(len=*), intent(in ) :: sum_file !< Name of file with summed fields character(len=*), intent(in ) :: snap_file !< Name of file with snapshot fields character(len=*), intent(in ) :: surf_file !< Name of file with surface fields + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_end !< End of timestep layer thickness [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: uhtr !< Zonal mass fluxes [kg] + intent(inout) :: uhtr !< Zonal mass fluxes [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(inout) :: vhtr !< Meridional mass fluxes [kg] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: h_end !< End of timestep layer thickness + intent(inout) :: vhtr !< Meridional mass fluxes [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: temp_mean !< Averaged temperature + intent(inout) :: temp_mean !< Averaged temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: salt_mean !< Averaged salinity + intent(inout) :: salt_mean !< Averaged salinity [ppt] real, dimension(SZI_(G),SZJ_(G)), & - intent(inout) :: mld !< Averaged mixed layer depth + intent(inout) :: mld !< Averaged mixed layer depth [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - intent(inout) :: Kd !< Diapycnal diffusivities at interfaces + intent(inout) :: Kd !< Diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] type(forcing), intent(inout) :: fluxes !< Fields with surface fluxes integer, intent(in ) :: ridx_sum !< Read index for sum, mean, and surf files integer, intent(in ) :: ridx_snap !< Read index for snapshot file @@ -656,15 +666,22 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ logical, optional, intent(in ) :: do_ale_in !< True if using ALE algorithms logical :: do_ale + real :: convert_to_H ! A scale conversion factor from the thickness units in the + ! file to H [H m-1 or H m2 kg-1 ~> 1] integer :: i, j, k, is, ie, js, je, nz - real :: Initer_vert do_ale = .false. - if (present(do_ale_in) ) do_ale = do_ale_in + if (present(do_ale_in)) do_ale = do_ale_in is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - ! Check if reading in UH, VH, and h_end + if (GV%Boussinesq) then + convert_to_H = GV%m_to_H + else + convert_to_H = GV%kg_m2_to_H + endif + + ! Check if reading in temperature, salinity, transports and ending thickness if (read_ts_uvh) then h_end(:,:,:) = 0.0 temp_mean(:,:,:) = 0.0 @@ -674,9 +691,9 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ ! Time-summed fields call MOM_read_vector(sum_file, 'uhtr_sum', 'vhtr_sum', uhtr(:,:,1:nk_input), & vhtr(:,:,1:nk_input), G%Domain, timelevel=ridx_sum, & - scale=GV%kg_m2_to_H) + scale=US%m_to_L**2*GV%kg_m2_to_H) call MOM_read_data(snap_file, 'h_end', h_end(:,:,1:nk_input), G%Domain, & - timelevel=ridx_snap,position=CENTER) + timelevel=ridx_snap, position=CENTER, scale=convert_to_H) call MOM_read_data(mean_file, 'temp', temp_mean(:,:,1:nk_input), G%Domain, & timelevel=ridx_sum,position=CENTER) call MOM_read_data(mean_file, 'salt', salt_mean(:,:,1:nk_input), G%Domain, & @@ -693,7 +710,7 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ ! Check if reading vertical diffusivities or entrainment fluxes call MOM_read_data( mean_file, 'Kd_interface', Kd(:,:,1:nk_input+1), G%Domain, & - timelevel=ridx_sum,position=CENTER) + timelevel=ridx_sum, position=CENTER, scale=US%m2_s_to_Z2_T) ! This block makes sure that the fluxes control structure, which may not be used in the solo_driver, ! contains netMassIn and netMassOut which is necessary for the applyTracerBoundaryFluxesInOut routine @@ -720,7 +737,7 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ endif if (read_mld) then - call MOM_read_data(surf_file, 'ePBL_h_ML', mld, G%Domain, timelevel=ridx_sum) + call MOM_read_data(surf_file, 'ePBL_h_ML', mld, G%Domain, timelevel=ridx_sum, scale=US%m_to_Z) endif if (read_sw) then @@ -729,9 +746,9 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ ! direct fluxes in the visible and near-infrared bands. For convenience, we store the ! sum of the direct and diffuse fluxes in the 'dir' field and set the 'dif' fields to zero call MOM_read_data(mean_file,'sw_vis', fluxes%sw_vis_dir, G%Domain, & - timelevel=ridx_sum, scale=G%US%W_m2_to_QRZ_T) + timelevel=ridx_sum, scale=US%W_m2_to_QRZ_T) call MOM_read_data(mean_file,'sw_nir', fluxes%sw_nir_dir, G%Domain, & - timelevel=ridx_sum, scale=G%US%W_m2_to_QRZ_T) + timelevel=ridx_sum, scale=US%W_m2_to_QRZ_T) fluxes%sw_vis_dir(:,:) = fluxes%sw_vis_dir(:,:)*0.5 fluxes%sw_vis_dif(:,:) = fluxes%sw_vis_dir(:,:) fluxes%sw_nir_dir(:,:) = fluxes%sw_nir_dir(:,:)*0.5 @@ -765,12 +782,14 @@ subroutine update_offline_from_arrays(G, GV, nk_input, ridx_sum, mean_file, sum_ character(len=200), intent(in ) :: mean_file !< Name of file with averages fields character(len=200), intent(in ) :: sum_file !< Name of file with summed fields character(len=200), intent(in ) :: snap_file !< Name of file with snapshot fields - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Zonal mass fluxes [kg] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Meridional mass fluxes [kg] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: hend !< End of timestep layer thickness [kg m-2] - real, dimension(:,:,:,:), allocatable, intent(inout) :: uhtr_all !< Zonal mass fluxes [kg] - real, dimension(:,:,:,:), allocatable, intent(inout) :: vhtr_all !< Meridional mass fluxes [kg] - real, dimension(:,:,:,:), allocatable, intent(inout) :: hend_all !< End of timestep layer thickness [kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Zonal mass fluxes [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Meridional mass fluxes [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: hend !< End of timestep layer thickness + !! [H ~> m or kg m-2] + real, dimension(:,:,:,:), allocatable, intent(inout) :: uhtr_all !< Zonal mass fluxes [H L2 ~> m3 or kg] + real, dimension(:,:,:,:), allocatable, intent(inout) :: vhtr_all !< Meridional mass fluxes [H L2 ~> m3 or kg] + real, dimension(:,:,:,:), allocatable, intent(inout) :: hend_all !< End of timestep layer thickness + !! [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: temp !< Temperature array real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: salt !< Salinity array real, dimension(:,:,:,:), allocatable, intent(inout) :: temp_all !< Temperature array diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 0a61ee1ba2..72041fbc86 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -63,12 +63,6 @@ module MOM_offline_main !< A pointer to the tracer registry type(thermo_var_ptrs), pointer :: tv => NULL() !< A structure pointing to various thermodynamic variables - type(ocean_grid_type), pointer :: G => NULL() - !< Pointer to a structure containing metrics and related information - type(verticalGrid_type), pointer :: GV => NULL() - !< Pointer to structure containing information about the vertical grid - type(unit_scale_type), pointer :: US => NULL() - !< structure containing various unit conversion factors type(optics_type), pointer :: optics => NULL() !< Pointer to the optical properties type type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() @@ -125,7 +119,8 @@ module MOM_offline_main !! This is copied from diabatic_CS controlling how tracers follow freshwater fluxes real :: Kd_max !< Runtime parameter specifying the maximum value of vertical diffusivity - real :: min_residual !< The minimum amount of total mass flux before exiting the main advection routine + real :: min_residual !< The minimum amount of total mass flux before exiting the main advection + !! routine [H L2 ~> m3 or kg] !>@{ Diagnostic manager IDs for some fields that may be of interest when doing offline transport integer :: & id_uhr = -1, & @@ -158,9 +153,9 @@ module MOM_offline_main integer :: id_clock_offline_adv = -1 !< A CPU time clock integer :: id_clock_redistribute = -1 !< A CPU time clock - !> Zonal transport that may need to be stored between calls to step_MOM + !> Zonal transport that may need to be stored between calls to step_MOM [H L2 ~> m3 or kg] real, allocatable, dimension(:,:,:) :: uhtr - !> Meridional transport that may need to be stored between calls to step_MOM + !> Meridional transport that may need to be stored between calls to step_MOM [H L2 ~> m3 or kg] real, allocatable, dimension(:,:,:) :: vhtr ! Fields at T-point @@ -171,19 +166,19 @@ module MOM_offline_main !< Amount of fluid entrained from the layer below within !! one time step [H ~> m or kg m-2] ! Fields at T-points on interfaces - real, allocatable, dimension(:,:,:) :: Kd !< Vertical diffusivity - real, allocatable, dimension(:,:,:) :: h_end !< Thicknesses at the end of offline timestep + real, allocatable, dimension(:,:,:) :: Kd !< Vertical diffusivity [Z2 T-1 ~> m2 s-1] + real, allocatable, dimension(:,:,:) :: h_end !< Thicknesses at the end of offline timestep [H ~> m or kg m-2] real, allocatable, dimension(:,:) :: netMassIn !< Freshwater fluxes into the ocean real, allocatable, dimension(:,:) :: netMassOut !< Freshwater fluxes out of the ocean - real, allocatable, dimension(:,:) :: mld !< Mixed layer depths at thickness points [Z ~> m]. + real, allocatable, dimension(:,:) :: mld !< Mixed layer depths at thickness points [Z ~> m] ! Allocatable arrays to read in entire fields during initialization - real, allocatable, dimension(:,:,:,:) :: uhtr_all !< Entire field of zonal transport - real, allocatable, dimension(:,:,:,:) :: vhtr_all !< Entire field of mericional transport - real, allocatable, dimension(:,:,:,:) :: hend_all !< Entire field of layer thicknesses - real, allocatable, dimension(:,:,:,:) :: temp_all !< Entire field of temperatures - real, allocatable, dimension(:,:,:,:) :: salt_all !< Entire field of salinities + real, allocatable, dimension(:,:,:,:) :: uhtr_all !< Entire field of zonal transport [H L2 ~> m3 or kg] + real, allocatable, dimension(:,:,:,:) :: vhtr_all !< Entire field of meridional transport [H L2 ~> m3 or kg] + real, allocatable, dimension(:,:,:,:) :: hend_all !< Entire field of layer thicknesses [H ~> m or kg m-2] + real, allocatable, dimension(:,:,:,:) :: temp_all !< Entire field of temperatures [degC] + real, allocatable, dimension(:,:,:,:) :: salt_all !< Entire field of salinities [ppt] end type offline_transport_CS @@ -206,41 +201,37 @@ module MOM_offline_main !> 3D advection is done by doing flux-limited nonlinear horizontal advection interspersed with an ALE !! regridding/remapping step. The loop in this routine is exited if remaining residual transports are below !! a runtime-specified value or a maximum number of iterations is reached. -subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock_ale, h_pre, uhtr, vhtr, converged) - type(forcing), intent(inout) :: fluxes !< pointers to forcing fields - type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< time interval - type(offline_transport_CS), pointer :: CS !< control structure for offline module - integer, intent(in) :: id_clock_ALE !< Clock for ALE routines - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & - intent(inout) :: h_pre !< layer thicknesses before advection - !! [H ~> m or kg m-2] - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & - intent(inout) :: uhtr !< Zonal mass transport [H m2 ~> m3 or kg] - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)), & - intent(inout) :: vhtr !< Meridional mass transport [H m2 ~> m3 or kg] - logical, intent( out) :: converged !< True if the iterations have converged - - ! Local pointers - type(ocean_grid_type), pointer :: G => NULL() ! Pointer to a structure containing - ! metrics and related information - type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to structure containing information - ! about the vertical grid - ! Work arrays for mass transports - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: uhtr_sub - ! Meridional mass transports - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)) :: vhtr_sub - - real :: prev_tot_residual, tot_residual ! Used to keep track of how close to convergence we are +subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, CS, id_clock_ale, & + h_pre, uhtr, vhtr, converged) + type(forcing), intent(inout) :: fluxes !< pointers to forcing fields + type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type + real, intent(in) :: time_interval !< time interval covered by this call [s] + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(offline_transport_CS), pointer :: CS !< control structure for offline module + integer, intent(in) :: id_clock_ALE !< Clock for ALE routines + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_pre !< layer thicknesses before advection + !! [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: uhtr !< Zonal mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(inout) :: vhtr !< Meridional mass transport [H L2 ~> m3 or kg] + logical, intent( out) :: converged !< True if the iterations have converged + + ! Local variables + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: uhtr_sub ! Substep zonal mass transports [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vhtr_sub ! Substep meridional mass transports [H L2 ~> m3 or kg] + + real :: prev_tot_residual, tot_residual ! Used to keep track of how close to convergence we are [H L2 ~> m3 or kg] ! Variables used to keep track of layer thicknesses at various points in the code - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & - h_new, & - h_vol - ! Fields for eta_diff diagnostic - real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_pre, eta_end - integer :: niter, iter - real :: Inum_iter + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & + h_new, & ! Updated layer thicknesses [H ~> m or kg m-2] + h_vol ! Layer volumes [H L2 ~> m3 or kg] + integer :: niter, iter + real :: Inum_iter ! The inverse of the number of iterations [nondim] character(len=256) :: mesg ! The text of an error message integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz integer :: isv, iev, jsv, jev ! The valid range of the indices. @@ -250,15 +241,11 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock ! top layer in a timestep [nondim] real :: minimum_forcing_depth ! The smallest depth over which fluxes can be applied [H ~> m or kg m-2] real :: dt_iter ! The timestep to use for each iteration [T ~> s] - - integer :: nstocks - real :: stock_values(MAX_FIELDS_) + real :: HL2_to_kg_scale ! Unit conversion factors to cell mass [kg H-1 L-2 ~> kg m-3 or 1] character(len=20) :: debug_msg call cpu_clock_begin(CS%id_clock_offline_adv) ! Grid-related pointer assignments - G => CS%G - GV => CS%GV x_before_y = CS%x_before_y @@ -270,6 +257,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock evap_CFL_limit = CS%evap_CFL_limit minimum_forcing_depth = CS%minimum_forcing_depth + HL2_to_kg_scale = US%L_to_m**2*GV%H_to_kg_m2 niter = CS%num_off_iter Inum_iter = 1./real(niter) dt_iter = CS%dt_offline*Inum_iter @@ -314,12 +302,12 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock enddo ; enddo ; enddo if (CS%debug) then - call hchksum(h_pre,"h_pre before transport",G%HI) - call uvchksum("[uv]htr_sub before transport", uhtr_sub, vhtr_sub, G%HI) + call hchksum(h_pre, "h_pre before transport", G%HI, scale=GV%H_to_m) + call uvchksum("[uv]htr_sub before transport", uhtr_sub, vhtr_sub, G%HI, scale=HL2_to_kg_scale) endif - tot_residual = remaining_transport_sum(CS, uhtr, vhtr) + tot_residual = remaining_transport_sum(G, GV, uhtr, vhtr) if (CS%print_adv_offline) then - write(mesg,'(A,ES24.16)') "Main advection starting transport: ", tot_residual + write(mesg,'(A,ES24.16)') "Main advection starting transport: ", tot_residual*HL2_to_kg_scale call MOM_mesg(mesg) endif @@ -328,18 +316,18 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock do iter=1,CS%num_off_iter do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_new(i,j,k) * G%US%L_to_m**2*G%areaT(i,j) + h_vol(i,j,k) = h_new(i,j,k) * G%areaT(i,j) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo if (CS%debug) then - call hchksum(h_vol,"h_vol before advect",G%HI) - call uvchksum("[uv]htr_sub before advect", uhtr_sub, vhtr_sub, G%HI) + call hchksum(h_vol, "h_vol before advect", G%HI, scale=HL2_to_kg_scale) + call uvchksum("[uv]htr_sub before advect", uhtr_sub, vhtr_sub, G%HI, scale=HL2_to_kg_scale) write(debug_msg, '(A,I4.4)') 'Before advect ', iter call MOM_tracer_chkinv(debug_msg, G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, CS%dt_offline, G, GV, CS%US, & + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, CS%dt_offline, G, GV, US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=1, & uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y) @@ -348,14 +336,14 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock ! Update the new layer thicknesses after one round of advection has happened do k=1,nz ; do j=js,je ; do i=is,ie - h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) + h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) !### Replace with "* G%IareaT(i,j)" enddo ; enddo ; enddo if (MODULO(iter,CS%off_ale_mod)==0) then ! Do ALE remapping/regridding to allow for more advection to occur in the next iteration call pass_var(h_new,G%Domain) if (CS%debug) then - call hchksum(h_new,"h_new before ALE",G%HI) + call hchksum(h_new,"h_new before ALE", G%HI, scale=GV%H_to_m) write(debug_msg, '(A,I4.4)') 'Before ALE ', iter call MOM_tracer_chkinv(debug_msg, G, GV, h_new, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif @@ -364,7 +352,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock call cpu_clock_end(id_clock_ALE) if (CS%debug) then - call hchksum(h_new,"h_new after ALE",G%HI) + call hchksum(h_new, "h_new after ALE", G%HI, scale=GV%H_to_m) write(debug_msg, '(A,I4.4)') 'After ALE ', iter call MOM_tracer_chkinv(debug_msg, G, GV, h_new, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif @@ -375,13 +363,13 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock vhtr_sub(i,J,k) = vhtr(i,J,k) enddo ; enddo ; enddo call pass_var(h_new, G%Domain) - call pass_vector(uhtr_sub,vhtr_sub,G%Domain) + call pass_vector(uhtr_sub, vhtr_sub, G%Domain) ! Check for whether we've used up all the advection, or if we need to move on because ! advection has stalled - tot_residual = remaining_transport_sum(CS, uhtr, vhtr) + tot_residual = remaining_transport_sum(G, GV, uhtr, vhtr) if (CS%print_adv_offline) then - write(mesg,'(A,ES24.16)') "Main advection remaining transport: ", tot_residual + write(mesg,'(A,ES24.16)') "Main advection remaining transport: ", tot_residual*HL2_to_kg_scale call MOM_mesg(mesg) endif ! If all the mass transports have been used u, then quit @@ -403,11 +391,11 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock ! Make sure that uhtr and vhtr halos are updated h_pre(:,:,:) = h_new(:,:,:) - call pass_vector(uhtr,vhtr,G%Domain) + call pass_vector(uhtr, vhtr, G%Domain) if (CS%debug) then - call hchksum(h_pre,"h after offline_advection_ale",G%HI) - call uvchksum("[uv]htr after offline_advection_ale", uhtr, vhtr, G%HI) + call hchksum(h_pre, "h after offline_advection_ale", G%HI, scale=GV%H_to_m) + call uvchksum("[uv]htr after offline_advection_ale", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) call MOM_tracer_chkinv("After offline_advection_ale", G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif @@ -419,53 +407,49 @@ end subroutine offline_advection_ale !! transport. Two different ways are offered, 'barotropic' means that the residual is distributed equally !! throughout the water column. 'upwards' attempts to redistribute the transport in the layers above and will !! eventually work down the entire water column -subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) +subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, converged) type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & - intent(inout) :: h_pre !< layer thicknesses before advection - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & - intent(inout) :: uhtr !< Zonal mass transport - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)), & - intent(inout) :: vhtr !< Meridional mass transport + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_pre !< layer thicknesses before advection [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: uhtr !< Zonal mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(inout) :: vhtr !< Meridional mass transport [H L2 ~> m3 or kg] logical, intent(in ) :: converged !< True if the iterations have converged - type(ocean_grid_type), pointer :: G => NULL() ! Pointer to a structure containing - ! metrics and related information - type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to structure containing information - ! about the vertical grid logical :: x_before_y ! Variables used to keep track of layer thicknesses at various points in the code - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & - h_new, & - h_vol + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & + h_new, & ! New layer thicknesses [H ~> m or kg m-2] + h_vol ! Cell volume [H L2 ~> m3 or kg] ! Used to calculate the eta diagnostics - real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_work - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: uhr !< Zonal mass transport - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)) :: vhr !< Meridional mass transport + real, dimension(SZI_(G),SZJ_(G)) :: eta_work ! The total column thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: uhr !< Remaining zonal mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vhr !< Remaining meridional mass transport [H L2 ~> m3 or kg] character(len=256) :: mesg ! The text of an error message integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz, iter - real :: prev_tot_residual, tot_residual, stock_values(MAX_FIELDS_) - integer :: nstocks - - ! Assign grid pointers - G => CS%G - GV => CS%GV + real :: HL2_to_kg_scale ! Unit conversion factors to cell mass [kg H-1 L-2 ~> kg m-3 or 1] + real :: prev_tot_residual, tot_residual ! The absolute value of the remaining transports [H L2 ~> m3 or kg] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed x_before_y = CS%x_before_y + HL2_to_kg_scale = US%L_to_m**2*GV%H_to_kg_m2 if (CS%id_eta_pre_distribute>0) then eta_work(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - if (h_pre(i,j,k)>GV%Angstrom_H) then + if (h_pre(i,j,k) > GV%Angstrom_H) then eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k) endif enddo ; enddo ; enddo - call post_data(CS%id_eta_pre_distribute,eta_work,CS%diag) + call post_data(CS%id_eta_pre_distribute, eta_work, CS%diag) endif ! These are used to find out how much will be redistributed in this routine @@ -489,17 +473,17 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) ! Calculate the layer volumes at beginning of redistribute do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k) * G%areaT(i,j) enddo ; enddo ; enddo call pass_var(h_vol,G%Domain) - call pass_vector(uhtr,vhtr,G%Domain) + call pass_vector(uhtr, vhtr, G%Domain) ! Store volumes for advect_tracer h_pre(:,:,:) = h_vol(:,:,:) if (CS%debug) then call MOM_tracer_chksum("Before upwards redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) - call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI) + call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) endif if (x_before_y) then @@ -510,9 +494,9 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) call distribute_residual_uh_upwards(G, GV, h_vol, uhtr) endif - call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, CS%US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt = h_pre, max_iter_in=1, & - h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) + call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, US, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt=h_pre, max_iter_in=1, & + h_out=h_vol, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) if (CS%debug) then call MOM_tracer_chksum("After upwards redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) @@ -522,8 +506,7 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) do k=1,nz ; do j=js,je ; do i=is,ie uhtr(I,j,k) = uhr(I,j,k) vhtr(i,J,k) = vhr(i,J,k) - h_vol(i,j,k) = h_new(i,j,k) - h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) + h_new(i,j,k) = h_vol(i,j,k) / (G%areaT(i,j)) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -534,17 +517,17 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) ! Calculate the layer volumes at beginning of redistribute do k=1,nz ; do j=js,je ; do i=is,ie - h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) + h_vol(i,j,k) = h_pre(i,j,k) * G%areaT(i,j) enddo ; enddo ; enddo - call pass_var(h_vol,G%Domain) - call pass_vector(uhtr,vhtr,G%Domain) + call pass_var(h_vol, G%Domain) + call pass_vector(uhtr, vhtr, G%Domain) ! Copy h_vol to h_pre for advect_tracer routine h_pre(:,:,:) = h_vol(:,:,:) if (CS%debug) then call MOM_tracer_chksum("Before barotropic redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) - call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI) + call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) endif if (x_before_y) then @@ -555,9 +538,9 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) call distribute_residual_uh_barotropic(G, GV, h_vol, uhtr) endif - call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, CS%US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt = h_pre, max_iter_in=1, & - h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) + call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, US, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt=h_pre, max_iter_in=1, & + h_out=h_vol, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) if (CS%debug) then call MOM_tracer_chksum("After barotropic redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) @@ -567,17 +550,16 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) do k=1,nz ; do j=js,je ; do i=is,ie uhtr(I,j,k) = uhr(I,j,k) vhtr(i,J,k) = vhr(i,J,k) - h_vol(i,j,k) = h_new(i,j,k) - h_new(i,j,k) = h_new(i,j,k) / (G%US%L_to_m**2*G%areaT(i,j)) + h_new(i,j,k) = h_vol(i,j,k) / (G%areaT(i,j)) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo endif ! redistribute barotropic ! Check to see if all transport has been exhausted - tot_residual = remaining_transport_sum(CS, uhtr, vhtr) + tot_residual = remaining_transport_sum(G, GV, uhtr, vhtr) if (CS%print_adv_offline) then - write(mesg,'(A,ES24.16)') "Residual advection remaining transport: ", tot_residual + write(mesg,'(A,ES24.16)') "Residual advection remaining transport: ", tot_residual*HL2_to_kg_scale call MOM_mesg(mesg) endif ! If the remaining residual is 0, then this return is done @@ -598,15 +580,15 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k) endif enddo ; enddo ; enddo - call post_data(CS%id_eta_post_distribute,eta_work,CS%diag) + call post_data(CS%id_eta_post_distribute, eta_work, CS%diag) endif - if (CS%id_uhr>0) call post_data(CS%id_uhr,uhtr,CS%diag) - if (CS%id_vhr>0) call post_data(CS%id_vhr,vhtr,CS%diag) + if (CS%id_uhr>0) call post_data(CS%id_uhr, uhtr, CS%diag) + if (CS%id_vhr>0) call post_data(CS%id_vhr, vhtr, CS%diag) if (CS%debug) then - call hchksum(h_pre,"h_pre after redistribute",G%HI) - call uvchksum("uhtr after redistribute", uhtr, vhtr, G%HI) + call hchksum(h_pre, "h_pre after redistribute", G%HI, scale=GV%H_to_m) + call uvchksum("uhtr after redistribute", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) call MOM_tracer_chkinv("after redistribute ", G, GV, h_new, CS%tracer_Reg%Tr, CS%tracer_Reg%ntr) endif @@ -614,11 +596,14 @@ subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) end subroutine offline_redistribute_residual -!> Sums any non-negligible remaining transport to check for advection convergence -real function remaining_transport_sum(CS, uhtr, vhtr) - type(offline_transport_CS), pointer :: CS !< control structure for offline module - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(in ) :: uhtr !< Zonal mass transport - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)), intent(in ) :: vhtr !< Meridional mass transport +!> Returns the sums of any non-negligible remaining transport [H L2 ~> m3 or kg] to check for advection convergence +real function remaining_transport_sum(G, GV, uhtr, vhtr) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(in ) :: uhtr !< Zonal mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(in ) :: vhtr !< Meridional mass transport [H L2 ~> m3 or kg] ! Local variables integer :: i, j, k @@ -627,15 +612,15 @@ real function remaining_transport_sum(CS, uhtr, vhtr) real :: uh_neglect !< A small value of zonal transport that effectively is below roundoff error real :: vh_neglect !< A small value of meridional transport that effectively is below roundoff error - nz = CS%GV%ke - is = CS%G%isc ; ie = CS%G%iec ; js = CS%G%jsc ; je = CS%G%jec + nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - h_min = CS%GV%H_subroundoff + h_min = GV%H_subroundoff remaining_transport_sum = 0. do k=1,nz ; do j=js,je ; do i=is,ie - uh_neglect = h_min*CS%G%US%L_to_m**2*MIN(CS%G%areaT(i,j),CS%G%areaT(i+1,j)) - vh_neglect = h_min*CS%G%US%L_to_m**2*MIN(CS%G%areaT(i,j),CS%G%areaT(i,j+1)) + uh_neglect = h_min * MIN(G%areaT(i,j), G%areaT(i+1,j)) + vh_neglect = h_min * MIN(G%areaT(i,j), G%areaT(i,j+1)) if (ABS(uhtr(I,j,k))>uh_neglect) then remaining_transport_sum = remaining_transport_sum + ABS(uhtr(I,j,k)) endif @@ -643,6 +628,7 @@ real function remaining_transport_sum(CS, uhtr, vhtr) remaining_transport_sum = remaining_transport_sum + ABS(vhtr(i,J,k)) endif enddo ; enddo ; enddo + !### The value of this sum is not layout independent. call sum_across_PEs(remaining_transport_sum) end function remaining_transport_sum @@ -650,40 +636,40 @@ end function remaining_transport_sum !> The vertical/diabatic driver for offline tracers. First the eatr/ebtr associated with the interpolated !! vertical diffusivities are calculated and then any tracer column functions are done which can include !! vertical diffuvities and source/sink terms. -subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, ebtr) - - type(forcing), intent(inout) :: fluxes !< pointers to forcing fields - type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - type(time_type), intent(in) :: Time_end !< time interval - type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & - intent(inout) :: h_pre !< layer thicknesses before advection [H ~> m or kg m-2] - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & - intent(inout) :: eatr !< Entrainment from layer above [H ~> m or kg m-2] - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), & - intent(inout) :: ebtr !< Entrainment from layer below [H ~> m or kg m-2] - - real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: & +subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, G, GV, US, CS, h_pre, eatr, ebtr) + + type(forcing), intent(inout) :: fluxes !< pointers to forcing fields + type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type + type(time_type), intent(in) :: Time_end !< ending time of a segment, as a time type + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_pre !< layer thicknesses before advection [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: eatr !< Entrainment from layer above [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: ebtr !< Entrainment from layer below [H ~> m or kg m-2] + + real, dimension(SZI_(G),SZJ_(G)) :: & sw, sw_vis, sw_nir !< Save old values of shortwave radiation [Q R Z T-1 ~> W m-2] - real :: hval - integer :: i,j,k - integer :: is, ie, js, je, nz + real :: I_hval ! An inverse thickness [H-1 ~> m2 kg-1] + integer :: i, j, k, is, ie, js, je, nz integer :: k_nonzero - real :: stock_values(MAX_FIELDS_) - real :: Kd_bot - integer :: nstocks - nz = CS%GV%ke - is = CS%G%isc ; ie = CS%G%iec ; js = CS%G%jsc ; je = CS%G%jec + real :: Kd_bot ! Near-bottom diffusivity [Z2 T-1 ~> m2 s-1] + nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec call cpu_clock_begin(CS%id_clock_offline_diabatic) call MOM_mesg("Applying tracer source, sinks, and vertical mixing") if (CS%debug) then - call hchksum(h_pre,"h_pre before offline_diabatic_ale",CS%G%HI) - call hchksum(eatr,"eatr before offline_diabatic_ale",CS%G%HI) - call hchksum(ebtr,"ebtr before offline_diabatic_ale",CS%G%HI) - call MOM_tracer_chkinv("Before offline_diabatic_ale", CS%G, CS%GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call hchksum(h_pre, "h_pre before offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call hchksum(eatr, "eatr before offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call hchksum(ebtr, "ebtr before offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call MOM_tracer_chkinv("Before offline_diabatic_ale", G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif eatr(:,:,:) = 0. @@ -712,8 +698,8 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e eatr(i,j,1) = 0. enddo ; enddo do k=2,nz ; do j=js,je ; do i=is,ie - hval=1.0/(CS%GV%H_subroundoff + 0.5*(h_pre(i,j,k-1) + h_pre(i,j,k))) - eatr(i,j,k) = (CS%GV%m_to_H**2*CS%US%T_to_s) * CS%dt_offline_vertical * hval * CS%Kd(i,j,k) + I_hval = 1.0 / (GV%H_subroundoff + 0.5*(h_pre(i,j,k-1) + h_pre(i,j,k))) + eatr(i,j,k) = GV%Z_to_H**2 * CS%dt_offline_vertical * I_hval * CS%Kd(i,j,k) ebtr(i,j,k-1) = eatr(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie @@ -725,17 +711,17 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e sw(:,:) = fluxes%sw(:,:) sw_vis(:,:) = fluxes%sw_vis_dir(:,:) sw_nir(:,:) = fluxes%sw_nir_dir(:,:) - call offline_add_diurnal_SW(fluxes, CS%G, Time_start, Time_end) + call offline_add_diurnal_SW(fluxes, G, Time_start, Time_end) endif if (associated(CS%optics)) & - call set_pen_shortwave(CS%optics, fluxes, CS%G, CS%GV, CS%US, CS%diabatic_aux_CSp, & + call set_pen_shortwave(CS%optics, fluxes, G, GV, US, CS%diabatic_aux_CSp, & CS%opacity_CSp, CS%tracer_flow_CSp) ! Note that tracerBoundaryFluxesInOut within this subroutine should NOT be called ! as the freshwater fluxes have already been accounted for call call_tracer_column_fns(h_pre, h_pre, eatr, ebtr, fluxes, CS%MLD, CS%dt_offline_vertical, & - CS%G, CS%GV, CS%US, CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) + G, GV, US, CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) if (CS%diurnal_SW .and. CS%read_sw) then fluxes%sw(:,:) = sw(:,:) @@ -744,10 +730,10 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e endif if (CS%debug) then - call hchksum(h_pre,"h_pre after offline_diabatic_ale",CS%G%HI) - call hchksum(eatr,"eatr after offline_diabatic_ale",CS%G%HI) - call hchksum(ebtr,"ebtr after offline_diabatic_ale",CS%G%HI) - call MOM_tracer_chkinv("After offline_diabatic_ale", CS%G, CS%GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + call hchksum(h_pre, "h_pre after offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call hchksum(eatr, "eatr after offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call hchksum(ebtr, "ebtr after offline_diabatic_ale", G%HI, scale=GV%H_to_m) + call MOM_tracer_chkinv("After offline_diabatic_ale", G, GV, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif call cpu_clock_end(CS%id_clock_offline_diabatic) @@ -768,7 +754,7 @@ subroutine offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional) !! of tracer that leaves with freshwater integer :: i, j, m - real, dimension(SZI_(G),SZJ_(G)) :: negative_fw !< store all negative fluxes + real, dimension(SZI_(G),SZJ_(G)) :: negative_fw !< store all negative fluxes [H ~> m or kg m-2] logical :: update_h !< Flag for whether h should be updated if ( present(in_flux_optional) ) & @@ -786,17 +772,17 @@ subroutine offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional) enddo ; enddo if (CS%debug) then - call hchksum(h, "h before fluxes into ocean", G%HI) + call hchksum(h, "h before fluxes into ocean", G%HI, scale=GV%H_to_m) call MOM_tracer_chkinv("Before fluxes into ocean", G, GV, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif do m = 1,CS%tracer_reg%ntr ! Layer thicknesses should only be updated after the last tracer is finished update_h = ( m == CS%tracer_reg%ntr ) call applyTracerBoundaryFluxesInOut(G, GV, CS%tracer_reg%tr(m)%t, CS%dt_offline, fluxes, h, & - CS%evap_CFL_limit, CS%minimum_forcing_depth, update_h_opt = update_h) + CS%evap_CFL_limit, CS%minimum_forcing_depth, update_h_opt=update_h) enddo if (CS%debug) then - call hchksum(h, "h after fluxes into ocean", G%HI) + call hchksum(h, "h after fluxes into ocean", G%HI, scale=GV%H_to_m) call MOM_tracer_chkinv("After fluxes into ocean", G, GV, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif @@ -824,7 +810,7 @@ subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional) call MOM_error(WARNING, "Negative freshwater fluxes with non-zero tracer concentration not supported yet") if (CS%debug) then - call hchksum(h,"h before fluxes out of ocean",G%HI) + call hchksum(h, "h before fluxes out of ocean", G%HI, scale=GV%H_to_m) call MOM_tracer_chkinv("Before fluxes out of ocean", G, GV, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif do m = 1, CS%tracer_reg%ntr @@ -834,7 +820,7 @@ subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional) CS%evap_CFL_limit, CS%minimum_forcing_depth, update_h_opt = update_h) enddo if (CS%debug) then - call hchksum(h,"h after fluxes out of ocean",G%HI) + call hchksum(h, "h after fluxes out of ocean", G%HI, scale=GV%H_to_m) call MOM_tracer_chkinv("Before fluxes out of ocean", G, GV, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif @@ -842,46 +828,48 @@ end subroutine offline_fw_fluxes_out_ocean !> When in layer mode, 3D horizontal advection using stored mass fluxes must be used. Horizontal advection is !! done via tracer_advect, whereas the vertical component is actually handled by vertdiff in tracer_column_fns -subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, eatr, ebtr, uhtr, vhtr) - type(forcing), intent(inout) :: fluxes !< pointers to forcing fields - type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< Offline transport time interval - type(offline_transport_CS), pointer :: CS !< Control structure for offline module - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: h_pre !< layer thicknesses before advection - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: eatr !< Entrainment from layer above - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: ebtr !< Entrainment from layer below - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: uhtr !< Zonal mass transport - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)), intent(inout) :: vhtr !< Meridional mass transport - ! Local pointers - type(ocean_grid_type), pointer :: G => NULL() ! Pointer to a structure containing - ! metrics and related information - type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to structure containing information - ! about the vertical grid - ! Remaining zonal mass transports - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: uhtr_sub - ! Remaining meridional mass transports - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)) :: vhtr_sub - - real :: sum_abs_fluxes, sum_u, sum_v ! Used to keep track of how close to convergence we are - real :: dt_offline +subroutine offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, CS, h_pre, eatr, ebtr, uhtr, vhtr) + type(forcing), intent(inout) :: fluxes !< pointers to forcing fields + type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type + real, intent(in) :: time_interval !< Offline transport time interval [s] + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(offline_transport_CS), pointer :: CS !< Control structure for offline module + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_pre !< layer thicknesses before advection [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: eatr !< Entrainment from layer above [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: ebtr !< Entrainment from layer below [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: uhtr !< Zonal mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(inout) :: vhtr !< Meridional mass transport [H L2 ~> m3 or kg] ! Local variables - ! Vertical diffusion related variables - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & + + ! Remaining zonal mass transports [H L2 ~> m3 or kg] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: uhtr_sub + ! Remaining meridional mass transports [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vhtr_sub + + real :: sum_abs_fluxes, sum_u, sum_v ! Used to keep track of how close to convergence we are [H L2 ~> m3 or kg] + ! Vertical diffusion related variables [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & eatr_sub, & ebtr_sub ! Variables used to keep track of layer thicknesses at various points in the code - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & - h_new, & - h_vol + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & + h_new, & ! Updated thicknesses [H ~> m or kg m-2] + h_vol ! Cell volumes [H L2 ~> m3 or kg] ! Work arrays for temperature and salinity - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & - temp_old, salt_old, & - temp_mean, salt_mean, & - zero_3dh ! + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & + temp_old, temp_mean, & ! Temperatures [degC] + salt_old, salt_mean ! Salinities [ppt] integer :: niter, iter - real :: Inum_iter real :: dt_iter ! The timestep of each iteration [T ~> s] + real :: HL2_to_kg_scale ! Unit conversion factors to cell mass [kg H-1 L-2 ~> kg m-3 or 1] logical :: converged character(len=160) :: mesg ! The text of an error message integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz @@ -889,26 +877,25 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, integer :: IsdB, IedB, JsdB, JedB logical :: z_first, x_before_y - G => CS%G ; GV => CS%GV is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - dt_iter = CS%US%s_to_T * time_interval / real(max(1, CS%num_off_iter)) + dt_iter = US%s_to_T * time_interval / real(max(1, CS%num_off_iter)) x_before_y = CS%x_before_y do iter=1,CS%num_off_iter - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 eatr_sub(i,j,k) = eatr(i,j,k) ebtr_sub(i,j,k) = ebtr(i,j,k) enddo ; enddo ; enddo - do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 + do k=1,nz ; do j=js-1,je+1 ; do i=is-2,ie+1 uhtr_sub(I,j,k) = uhtr(I,j,k) enddo ; enddo ; enddo - do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-2,je+1 ; do i=is-1,ie+1 vhtr_sub(i,J,k) = vhtr(i,J,k) enddo ; enddo ; enddo @@ -920,23 +907,23 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, ! First do vertical advection call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & - fluxes, CS%mld, dt_iter, G, GV, CS%US, CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) + fluxes, CS%mld, dt_iter, G, GV, US, CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) ! We are now done with the vertical mass transports, so now h_new is h_sub - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo call pass_var(h_pre,G%Domain) ! Second zonal and meridional advection call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) - do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 - h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) + do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + h_vol(i,j,k) = h_pre(i,j,k) * G%areaT(i,j) enddo ; enddo ; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, CS%US, & + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) ! Done with horizontal so now h_pre should be h_new - do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -946,39 +933,39 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, ! First zonal and meridional advection call update_h_horizontal_flux(G, GV, uhtr_sub, vhtr_sub, h_pre, h_new) - do k = 1, nz ; do i = is-1, ie+1 ; do j=js-1, je+1 - h_vol(i,j,k) = h_pre(i,j,k)*G%US%L_to_m**2*G%areaT(i,j) + do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + h_vol(i,j,k) = h_pre(i,j,k) * G%areaT(i,j) enddo ; enddo ; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, CS%US, & + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, US, & CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) ! Done with horizontal so now h_pre should be h_new - do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo ! Second vertical advection call update_h_vertical_flux(G, GV, eatr_sub, ebtr_sub, h_pre, h_new) call call_tracer_column_fns(h_pre, h_new, eatr_sub, ebtr_sub, & - fluxes, CS%mld, dt_iter, G, GV, CS%US, CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) + fluxes, CS%mld, dt_iter, G, GV, US, CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) ! We are now done with the vertical mass transports, so now h_new is h_sub - do k = 1, nz ; do i=is-1,ie+1 ; do j=js-1,je+1 + do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo endif ! Update remaining transports - do k = 1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 eatr(i,j,k) = eatr(i,j,k) - eatr_sub(i,j,k) ebtr(i,j,k) = ebtr(i,j,k) - ebtr_sub(i,j,k) enddo ; enddo ; enddo - do k = 1, nz ; do j=js-1,je+1 ; do i=is-2,ie+1 + do k=1,nz ; do j=js-1,je+1 ; do i=is-2,ie+1 uhtr(I,j,k) = uhtr(I,j,k) - uhtr_sub(I,j,k) enddo ; enddo ; enddo - do k = 1, nz ; do j=js-2,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-2,je+1 ; do i=is-1,ie+1 vhtr(i,J,k) = vhtr(i,J,k) - vhtr_sub(i,J,k) enddo ; enddo ; enddo @@ -999,7 +986,10 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, enddo ; enddo ; enddo call sum_across_PEs(sum_abs_fluxes) - write(mesg,*) "offline_advection_layer: Remaining u-flux, v-flux:", sum_u, sum_v + HL2_to_kg_scale = US%L_to_m**2*GV%H_to_kg_m2 + + write(mesg,*) "offline_advection_layer: Remaining u-flux, v-flux:", & + sum_u*HL2_to_kg_scale, sum_v*HL2_to_kg_scale call MOM_mesg(mesg) if (sum_abs_fluxes==0) then write(mesg,*) 'offline_advection_layer: Converged after iteration', iter @@ -1016,42 +1006,59 @@ end subroutine offline_advection_layer !> Update fields used in this round of offline transport. First fields are updated from files or from arrays !! read during initialization. Then if in an ALE-dependent coordinate, regrid/remap fields. -subroutine update_offline_fields(CS, h, fluxes, do_ale) - type(offline_transport_CS), pointer :: CS !< Control structure for offline module - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: h !< The regridded layer thicknesses - type(forcing), intent(inout) :: fluxes !< Pointers to forcing fields - logical, intent(in ) :: do_ale !< True if using ALE +subroutine update_offline_fields(CS, G, GV, US, h, fluxes, do_ale) + type(offline_transport_CS), pointer :: CS !< Control structure for offline module + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h !< The regridded layer thicknesses [H ~> m or kg m-2] + type(forcing), intent(inout) :: fluxes !< Pointers to forcing fields + logical, intent(in ) :: do_ale !< True if using ALE ! Local variables integer :: i, j, k, is, ie, js, je, nz - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: h_start - is = CS%G%isc ; ie = CS%G%iec ; js = CS%G%jsc ; je = CS%G%jec ; nz = CS%GV%ke + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_start ! Initial thicknesses [H ~> m or kg m-2] + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke call cpu_clock_begin(CS%id_clock_read_fields) call callTree_enter("update_offline_fields, MOM_offline_main.F90") + if (CS%debug) then + call uvchksum("[uv]htr before update_offline_fields", CS%uhtr, CS%vhtr, G%HI, & + scale=US%L_to_m**2*GV%H_to_kg_m2) + call hchksum(CS%h_end, "h_end before update_offline_fields", G%HI, scale=GV%H_to_m) + call hchksum(CS%tv%T, "Temp before update_offline_fields", G%HI) + call hchksum(CS%tv%S, "Salt before update_offline_fields", G%HI) + endif + ! Store a copy of the layer thicknesses before ALE regrid/remap h_start(:,:,:) = h(:,:,:) ! Most fields will be read in from files - call update_offline_from_files( CS%G, CS%GV, CS%nk_input, CS%mean_file, CS%sum_file, CS%snap_file, CS%surf_file, & - CS%h_end, CS%uhtr, CS%vhtr, CS%tv%T, CS%tv%S, CS%mld, CS%Kd, fluxes, & - CS%ridx_sum, CS%ridx_snap, CS%read_mld, CS%read_sw, .not. CS%read_all_ts_uvh, do_ale) + call update_offline_from_files( G, GV, US, CS%nk_input, CS%mean_file, CS%sum_file, CS%snap_file, & + CS%surf_file, CS%h_end, CS%uhtr, CS%vhtr, CS%tv%T, CS%tv%S, & + CS%mld, CS%Kd, fluxes, CS%ridx_sum, CS%ridx_snap, CS%read_mld, & + CS%read_sw, .not.CS%read_all_ts_uvh, do_ale) ! If uh, vh, h_end, temp, salt were read in at the beginning, fields are copied from those arrays if (CS%read_all_ts_uvh) then - call update_offline_from_arrays(CS%G, CS%GV, CS%nk_input, CS%ridx_sum, CS%mean_file, CS%sum_file, CS%snap_file, & - CS%uhtr, CS%vhtr, CS%h_end, CS%uhtr_all, CS%vhtr_all, CS%hend_all, CS%tv%T, CS%tv%S, CS%temp_all, CS%salt_all) - endif + call update_offline_from_arrays(G, GV, CS%nk_input, CS%ridx_sum, CS%mean_file, CS%sum_file, & + CS%snap_file, CS%uhtr, CS%vhtr, CS%h_end, CS%uhtr_all, CS%vhtr_all, & + CS%hend_all, CS%tv%T, CS%tv%S, CS%temp_all, CS%salt_all) + endif if (CS%debug) then - call uvchksum("[uv]h after update offline from files and arrays", CS%uhtr, CS%vhtr, CS%G%HI) + call uvchksum("[uv]h after update offline from files and arrays", CS%uhtr, CS%vhtr, G%HI, & + scale=US%L_to_m**2*GV%H_to_kg_m2) + call hchksum(CS%tv%T, "Temp after update offline from files and arrays", G%HI) + call hchksum(CS%tv%S, "Salt after update offline from files and arrays", G%HI) endif ! If using an ALE-dependent vertical coordinate, fields will need to be remapped if (do_ale) then ! These halo passes are necessary because u, v fields will need information 1 step into the halo - call pass_var(h, CS%G%Domain) - call pass_var(CS%tv%T, CS%G%Domain) - call pass_var(CS%tv%S, CS%G%Domain) - call ALE_offline_inputs(CS%ALE_CSp, CS%G, CS%GV, h, CS%tv, CS%tracer_Reg, CS%uhtr, CS%vhtr, CS%Kd, & + call pass_var(h, G%Domain) + call pass_var(CS%tv%T, G%Domain) + call pass_var(CS%tv%S, G%Domain) + call ALE_offline_inputs(CS%ALE_CSp, G, GV, h, CS%tv, CS%tracer_Reg, CS%uhtr, CS%vhtr, CS%Kd, & CS%debug, CS%OBC) if (CS%id_temp_regrid>0) call post_data(CS%id_temp_regrid, CS%tv%T, CS%diag) if (CS%id_salt_regrid>0) call post_data(CS%id_salt_regrid, CS%tv%S, CS%diag) @@ -1059,15 +1066,16 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale) if (CS%id_vhtr_regrid>0) call post_data(CS%id_vhtr_regrid, CS%vhtr, CS%diag) if (CS%id_h_regrid>0) call post_data(CS%id_h_regrid, h, CS%diag) if (CS%debug) then - call uvchksum("[uv]h after ALE regridding/remapping of inputs", CS%uhtr, CS%vhtr, CS%G%HI) - call hchksum(h_start,"h_start after update offline from files and arrays", CS%G%HI) + call uvchksum("[uv]htr after ALE regridding/remapping of inputs", CS%uhtr, CS%vhtr, G%HI, & + scale=US%L_to_m**2*GV%H_to_kg_m2) + call hchksum(h_start,"h_start after ALE regridding/remapping of inputs", G%HI, scale=GV%H_to_m) endif endif ! Update halos for some - call pass_var(CS%h_end, CS%G%Domain) - call pass_var(CS%tv%T, CS%G%Domain) - call pass_var(CS%tv%S, CS%G%Domain) + call pass_var(CS%h_end, G%Domain) + call pass_var(CS%tv%T, G%Domain) + call pass_var(CS%tv%S, G%Domain) ! Update the read indices CS%ridx_snap = next_modulo_time(CS%ridx_snap,CS%numtime) @@ -1075,8 +1083,8 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale) ! Apply masks/factors at T, U, and V points do k=1,nz ; do j=js,je ; do i=is,ie - if (CS%G%mask2dT(i,j)<1.0) then - CS%h_end(i,j,k) = CS%GV%Angstrom_H + if (G%mask2dT(i,j)<1.0) then + CS%h_end(i,j,k) = GV%Angstrom_H endif enddo ; enddo ; enddo @@ -1088,22 +1096,23 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale) enddo ; enddo ; enddo do k=1,nz ; do J=js-1,je ; do i=is,ie - if (CS%G%mask2dCv(i,J)<1.0) then + if (G%mask2dCv(i,J)<1.0) then CS%vhtr(i,J,k) = 0.0 endif enddo ; enddo ; enddo do k=1,nz ; do j=js,je ; do I=is-1,ie - if (CS%G%mask2dCu(I,j)<1.0) then + if (G%mask2dCu(I,j)<1.0) then CS%uhtr(I,j,k) = 0.0 endif enddo ; enddo ; enddo if (CS%debug) then - call uvchksum("[uv]htr_sub after update_offline_fields", CS%uhtr, CS%vhtr, CS%G%HI) - call hchksum(CS%h_end, "h_end after update_offline_fields", CS%G%HI) - call hchksum(CS%tv%T, "Temp after update_offline_fields", CS%G%HI) - call hchksum(CS%tv%S, "Salt after update_offline_fields", CS%G%HI) + call uvchksum("[uv]htr after update_offline_fields", CS%uhtr, CS%vhtr, G%HI, & + scale=US%L_to_m**2*GV%H_to_kg_m2) + call hchksum(CS%h_end, "h_end after update_offline_fields", G%HI, scale=GV%H_to_m) + call hchksum(CS%tv%T, "Temp after update_offline_fields", G%HI) + call hchksum(CS%tv%S, "Salt after update_offline_fields", G%HI) endif call callTree_leave("update_offline_fields") @@ -1112,80 +1121,100 @@ subroutine update_offline_fields(CS, h, fluxes, do_ale) end subroutine update_offline_fields !> Initialize additional diagnostics required for offline tracer transport -subroutine register_diags_offline_transport(Time, diag, CS) +subroutine register_diags_offline_transport(Time, diag, CS, GV, US) type(offline_transport_CS), pointer :: CS !< Control structure for offline module + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(time_type), intent(in) :: Time !< current model time type(diag_ctrl), intent(in) :: diag !< Structure that regulates diagnostic output ! U-cell fields CS%id_uhr = register_diag_field('ocean_model', 'uhr', diag%axesCuL, Time, & - 'Zonal thickness fluxes remaining at end of advection', 'kg') + 'Zonal thickness fluxes remaining at end of advection', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_uhr_redist = register_diag_field('ocean_model', 'uhr_redist', diag%axesCuL, Time, & - 'Zonal thickness fluxes to be redistributed vertically', 'kg') + 'Zonal thickness fluxes to be redistributed vertically', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_uhr_end = register_diag_field('ocean_model', 'uhr_end', diag%axesCuL, Time, & - 'Zonal thickness fluxes at end of offline step', 'kg') + 'Zonal thickness fluxes at end of offline step', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) ! V-cell fields CS%id_vhr = register_diag_field('ocean_model', 'vhr', diag%axesCvL, Time, & - 'Meridional thickness fluxes remaining at end of advection', 'kg') + 'Meridional thickness fluxes remaining at end of advection', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_vhr_redist = register_diag_field('ocean_model', 'vhr_redist', diag%axesCvL, Time, & - 'Meridional thickness to be redistributed vertically', 'kg') + 'Meridional thickness to be redistributed vertically', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_vhr_end = register_diag_field('ocean_model', 'vhr_end', diag%axesCvL, Time, & - 'Meridional thickness at end of offline step', 'kg') + 'Meridional thickness at end of offline step', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) ! T-cell fields CS%id_hdiff = register_diag_field('ocean_model', 'hdiff', diag%axesTL, Time, & - 'Difference between the stored and calculated layer thickness', 'm') + 'Difference between the stored and calculated layer thickness', & + 'm', conversion=GV%H_to_m) CS%id_hr = register_diag_field('ocean_model', 'hr', diag%axesTL, Time, & - 'Layer thickness at end of offline step', 'm') + 'Layer thickness at end of offline step', 'm', conversion=GV%H_to_m) CS%id_ear = register_diag_field('ocean_model', 'ear', diag%axesTL, Time, & 'Remaining thickness entrained from above', 'm') CS%id_ebr = register_diag_field('ocean_model', 'ebr', diag%axesTL, Time, & 'Remaining thickness entrained from below', 'm') CS%id_eta_pre_distribute = register_diag_field('ocean_model','eta_pre_distribute', & - diag%axesT1, Time, 'Total water column height before residual transport redistribution','m') + diag%axesT1, Time, 'Total water column height before residual transport redistribution', & + 'm', conversion=GV%H_to_m) CS%id_eta_post_distribute = register_diag_field('ocean_model','eta_post_distribute', & - diag%axesT1, Time, 'Total water column height after residual transport redistribution','m') + diag%axesT1, Time, 'Total water column height after residual transport redistribution', & + 'm', conversion=GV%H_to_m) CS%id_eta_diff_end = register_diag_field('ocean_model','eta_diff_end', diag%axesT1, Time, & 'Difference in total water column height from online and offline ' // & - 'at the end of the offline timestep','m') + 'at the end of the offline timestep', 'm', conversion=GV%H_to_m) CS%id_h_redist = register_diag_field('ocean_model','h_redist', diag%axesTL, Time, & - 'Layer thicknesses before redistribution of mass fluxes','m') + 'Layer thicknesses before redistribution of mass fluxes', & + 'm', conversion=GV%H_to_m) ! Regridded/remapped input fields CS%id_uhtr_regrid = register_diag_field('ocean_model', 'uhtr_regrid', diag%axesCuL, Time, & - 'Zonal mass transport regridded/remapped onto offline grid','kg') + 'Zonal mass transport regridded/remapped onto offline grid', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_vhtr_regrid = register_diag_field('ocean_model', 'vhtr_regrid', diag%axesCvL, Time, & - 'Meridional mass transport regridded/remapped onto offline grid','kg') + 'Meridional mass transport regridded/remapped onto offline grid', & + 'kg', conversion=US%L_to_m**2*GV%H_to_kg_m2) CS%id_temp_regrid = register_diag_field('ocean_model', 'temp_regrid', diag%axesTL, Time, & 'Temperature regridded/remapped onto offline grid','C') CS%id_salt_regrid = register_diag_field('ocean_model', 'salt_regrid', diag%axesTL, Time, & 'Salinity regridded/remapped onto offline grid','g kg-1') CS%id_h_regrid = register_diag_field('ocean_model', 'h_regrid', diag%axesTL, Time, & - 'Layer thicknesses regridded/remapped onto offline grid','m') - + 'Layer thicknesses regridded/remapped onto offline grid', & + 'm', conversion=GV%H_to_m) end subroutine register_diags_offline_transport !> Posts diagnostics related to offline convergence diagnostics -subroutine post_offline_convergence_diags(CS, h_off, h_end, uhtr, vhtr) +subroutine post_offline_convergence_diags(G, GV, CS, h_off, h_end, uhtr, vhtr) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(offline_transport_CS), intent(in ) :: CS !< Offline control structure - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: h_off !< Thicknesses at end of offline step - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: h_end !< Stored thicknesses - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%GV)), intent(inout) :: uhtr !< Remaining zonal mass transport - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%GV)), intent(inout) :: vhtr !< Remaining meridional mass transport + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_off !< Thicknesses at end of offline step [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_end !< Stored thicknesses [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: uhtr !< Remaining zonal mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(inout) :: vhtr !< Remaining meridional mass transport [H L2 ~> m3 or kg] - real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_diff + real, dimension(SZI_(G),SZJ_(G)) :: eta_diff ! Differences in column thickness [H ~> m or kg m-2] integer :: i, j, k if (CS%id_eta_diff_end>0) then ! Calculate difference in column thickness eta_diff = 0. - do k=1,CS%GV%ke ; do j=CS%G%jsc,CS%G%jec ; do i=CS%G%isc,CS%G%iec + do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec eta_diff(i,j) = eta_diff(i,j) + h_off(i,j,k) enddo ; enddo ; enddo - do k=1,CS%GV%ke ; do j=CS%G%jsc,CS%G%jec ; do i=CS%G%isc,CS%G%iec + do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec eta_diff(i,j) = eta_diff(i,j) - h_end(i,j,k) enddo ; enddo ; enddo @@ -1205,8 +1234,8 @@ subroutine extract_offline_main(CS, uhtr, vhtr, eatr, ebtr, h_end, accumulated_t dt_offline, dt_offline_vertical, skip_diffusion) type(offline_transport_CS), target, intent(in ) :: CS !< Offline control structure ! Returned optional arguments - real, dimension(:,:,:), optional, pointer :: uhtr !< Remaining zonal mass transport [H m2 ~> m3 or kg] - real, dimension(:,:,:), optional, pointer :: vhtr !< Remaining meridional mass transport [H m2 ~> m3 or kg] + real, dimension(:,:,:), optional, pointer :: uhtr !< Remaining zonal mass transport [H L2 ~> m3 or kg] + real, dimension(:,:,:), optional, pointer :: vhtr !< Remaining meridional mass transport [H L2 ~> m3 or kg] real, dimension(:,:,:), optional, pointer :: eatr !< Amount of fluid entrained from the layer above within !! one time step [H ~> m or kg m-2] real, dimension(:,:,:), optional, pointer :: ebtr !< Amount of fluid entrained from the layer below within @@ -1243,7 +1272,7 @@ end subroutine extract_offline_main !> Inserts (assigns values to) members of the offline main control structure. All arguments !! are optional except for the CS itself subroutine insert_offline_main(CS, ALE_CSp, diabatic_CSp, diag, OBC, tracer_adv_CSp, & - tracer_flow_CSp, tracer_Reg, tv, G, GV, x_before_y, debug) + tracer_flow_CSp, tracer_Reg, tv, x_before_y, debug) type(offline_transport_CS), intent(inout) :: CS !< Offline control structure ! Inserted optional arguments type(ALE_CS), & @@ -1262,10 +1291,6 @@ subroutine insert_offline_main(CS, ALE_CSp, diabatic_CSp, diag, OBC, tracer_adv_ target, optional, intent(in ) :: tracer_Reg !< A pointer to the tracer registry type(thermo_var_ptrs), & target, optional, intent(in ) :: tv !< A structure pointing to various thermodynamic variables - type(ocean_grid_type), & - target, optional, intent(in ) :: G !< ocean grid structure - type(verticalGrid_type), & - target, optional, intent(in ) :: GV !< ocean vertical grid structure logical, optional, intent(in ) :: x_before_y !< Indicates which horizontal direction is advected first logical, optional, intent(in ) :: debug !< If true, write verbose debugging messages @@ -1278,8 +1303,6 @@ subroutine insert_offline_main(CS, ALE_CSp, diabatic_CSp, diag, OBC, tracer_adv_ if (present(tracer_flow_CSp)) CS%tracer_flow_CSp => tracer_flow_CSp if (present(tracer_Reg)) CS%tracer_Reg => tracer_Reg if (present(tv)) CS%tv => tv - if (present(G)) CS%G => G - if (present(GV)) CS%GV => GV if (present(x_before_y)) CS%x_before_y = x_before_y if (present(debug)) CS%debug = debug @@ -1309,37 +1332,33 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) call callTree_enter("offline_transport_init, MOM_offline_control.F90") if (associated(CS)) then - call MOM_error(WARNING, "offline_transport_init called with an associated "// & - "control structure.") + call MOM_error(WARNING, "offline_transport_init called with an associated control structure.") return endif allocate(CS) call log_version(param_file, mdl,version, "This module allows for tracers to be run offline") - ! Determining the internal unit scaling factors for this run. - CS%US => US - ! Parse MOM_input for offline control call get_param(param_file, mdl, "OFFLINEDIR", CS%offlinedir, & - "Input directory where the offline fields can be found", fail_if_missing = .true.) + "Input directory where the offline fields can be found", fail_if_missing=.true.) call get_param(param_file, mdl, "OFF_SUM_FILE", CS%sum_file, & - "Filename where the accumulated fields can be found", fail_if_missing = .true.) + "Filename where the accumulated fields can be found", fail_if_missing=.true.) call get_param(param_file, mdl, "OFF_SNAP_FILE", CS%snap_file, & - "Filename where snapshot fields can be found", fail_if_missing = .true.) + "Filename where snapshot fields can be found", fail_if_missing=.true.) call get_param(param_file, mdl, "OFF_MEAN_FILE", CS%mean_file, & - "Filename where averaged fields can be found", fail_if_missing = .true.) + "Filename where averaged fields can be found", fail_if_missing=.true.) call get_param(param_file, mdl, "OFF_SURF_FILE", CS%surf_file, & - "Filename where averaged fields can be found", fail_if_missing = .true.) + "Filename where averaged fields can be found", fail_if_missing=.true.) call get_param(param_file, mdl, "NUMTIME", CS%numtime, & - "Number of timelevels in offline input files", fail_if_missing = .true.) + "Number of timelevels in offline input files", fail_if_missing=.true.) call get_param(param_file, mdl, "NK_INPUT", CS%nk_input, & - "Number of vertical levels in offline input files", default = nz) + "Number of vertical levels in offline input files", default=nz) call get_param(param_file, mdl, "DT_OFFLINE", CS%dt_offline, & - "Length of time between reading in of input fields", units='s', scale=US%s_to_T, fail_if_missing = .true.) + "Length of time between reading in of input fields", units='s', scale=US%s_to_T, fail_if_missing=.true.) call get_param(param_file, mdl, "DT_OFFLINE_VERTICAL", CS%dt_offline_vertical, & "Length of the offline timestep for tracer column sources/sinks " //& "This should be set to the length of the coupling timestep for " //& - "tracers which need shortwave fluxes", units="s", scale=US%s_to_T, fail_if_missing = .true.) + "tracers which need shortwave fluxes", units="s", scale=US%s_to_T, fail_if_missing=.true.) call get_param(param_file, mdl, "START_INDEX", CS%start_index, & "Which time index to start from", default=1) call get_param(param_file, mdl, "FIELDS_ARE_OFFSET", CS%fields_are_offset, & @@ -1355,42 +1374,40 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) default='barotropic') call get_param(param_file, mdl, "NUM_OFF_ITER", CS%num_off_iter, & "Number of iterations to subdivide the offline tracer advection and diffusion", & - default = 60) + default=60) call get_param(param_file, mdl, "OFF_ALE_MOD", CS%off_ale_mod, & - "Sets how many horizontal advection steps are taken before an ALE " //& - "remapping step is done. 1 would be x->y->ALE, 2 would be" //& - "x->y->x->y->ALE", default = 1) + "Sets how many horizontal advection steps are taken before an ALE "//& + "remapping step is done. 1 would be x->y->ALE, 2 would be x->y->x->y->ALE", default=1) call get_param(param_file, mdl, "PRINT_ADV_OFFLINE", CS%print_adv_offline, & - "Print diagnostic output every advection subiteration",default=.false.) + "Print diagnostic output every advection subiteration", default=.false.) call get_param(param_file, mdl, "SKIP_DIFFUSION_OFFLINE", CS%skip_diffusion, & - "Do not do horizontal diffusion",default=.false.) + "Do not do horizontal diffusion", default=.false.) call get_param(param_file, mdl, "READ_SW", CS%read_sw, & - "Read in shortwave radiation field instead of using values from the coupler"//& - "when in offline tracer mode",default=.false.) + "Read in shortwave radiation field instead of using values from the coupler "//& + "when in offline tracer mode", default=.false.) call get_param(param_file, mdl, "READ_MLD", CS%read_mld, & - "Read in mixed layer depths for tracers which exchange with the atmosphere"//& - "when in offline tracer mode",default=.false.) + "Read in mixed layer depths for tracers which exchange with the atmosphere "//& + "when in offline tracer mode", default=.false.) call get_param(param_file, mdl, "MLD_VAR_NAME", CS%mld_var_name, & - "Name of the variable containing the depth of active mixing",& - default='ePBL_h_ML') + "Name of the variable containing the depth of active mixing", default='ePBL_h_ML') call get_param(param_file, mdl, "OFFLINE_ADD_DIURNAL_SW", CS%diurnal_sw, & - "Adds a synthetic diurnal cycle in the same way that the ice " // & - "model would have when time-averaged fields of shortwave " // & + "Adds a synthetic diurnal cycle in the same way that the ice "//& + "model would have when time-averaged fields of shortwave "//& "radiation are read in", default=.false.) call get_param(param_file, mdl, "KD_MAX", CS%Kd_max, & "The maximum permitted increment for the diapycnal "//& "diffusivity from TKE-based parameterizations, or a "//& - "negative value for no limit.", units="m2 s-1", default=-1.0) + "negative value for no limit.", units="m2 s-1", default=-1.0, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "MIN_RESIDUAL_TRANSPORT", CS%min_residual, & - "How much remaining transport before the main offline advection "// & - "is exited. The default value corresponds to about 1 meter of " // & - "difference in a grid cell", default = 1.e9) + "How much remaining transport before the main offline advection is exited. "//& + "The default value corresponds to about 1 meter of difference in a grid cell", & + default=1.e9, units="m3", scale=GV%m_to_H*US%m_to_L**2) call get_param(param_file, mdl, "READ_ALL_TS_UVH", CS%read_all_ts_uvh, & "Reads all time levels of a subset of the fields necessary to run " // & "the model offline. This can require a large amount of memory "// & "and will make initialization very slow. However, for offline "// & "runs spanning more than a year this can reduce total I/O overhead", & - default = .false.) + default=.false.) ! Concatenate offline directory and file names CS%snap_file = trim(CS%offlinedir)//trim(CS%snap_file) @@ -1398,7 +1415,7 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) CS%sum_file = trim(CS%offlinedir)//trim(CS%sum_file) CS%surf_file = trim(CS%offlinedir)//trim(CS%surf_file) - CS%num_vert_iter = CS%dt_offline/CS%dt_offline_vertical + CS%num_vert_iter = CS%dt_offline / CS%dt_offline_vertical ! Map redistribute_method onto logicals in CS select case (redistribute_method) @@ -1430,10 +1447,6 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) evap_CFL_limit=CS%evap_CFL_limit, & minimum_forcing_depth=CS%minimum_forcing_depth) - ! Grid pointer assignments - CS%G => G - CS%GV => GV - ! Allocate arrays allocate(CS%uhtr(IsdB:IedB,jsd:jed,nz), source=0.0) allocate(CS%vhtr(isd:ied,JsdB:JedB,nz), source=0.0) @@ -1446,7 +1459,7 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) if (CS%read_mld) allocate(CS%mld(G%isd:G%ied,G%jsd:G%jed), source=0.0) if (CS%read_all_ts_uvh) then - call read_all_input(CS) + call read_all_input(CS, G, GV, US) endif ! Initialize ids for clocks used in offline routines @@ -1461,15 +1474,18 @@ end subroutine offline_transport_init !> Coordinates the allocation and reading in all time levels of uh, vh, hend, temp, and salt from files. Used !! when read_all_ts_uvh -subroutine read_all_input(CS) - type(offline_transport_CS), intent(inout) :: CS !< Control structure for offline module +subroutine read_all_input(CS, G, GV, US) + type(offline_transport_CS), intent(inout) :: CS !< Control structure for offline module + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer :: is, ie, js, je, isd, ied, jsd, jed, nz, t, ntime integer :: IsdB, IedB, JsdB, JedB - nz = CS%GV%ke ; ntime = CS%numtime - isd = CS%G%isd ; ied = CS%G%ied ; jsd = CS%G%jsd ; jed = CS%G%jed - IsdB = CS%G%IsdB ; IedB = CS%G%IedB ; JsdB = CS%G%JsdB ; JedB = CS%G%JedB + nz = GV%ke ; ntime = CS%numtime + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! Extra safety check that we're not going to overallocate any arrays if (CS%read_all_ts_uvh) then @@ -1488,13 +1504,14 @@ subroutine read_all_input(CS) call MOM_mesg("Reading in uhtr, vhtr, h_start, h_end, temp, salt") do t = 1,ntime call MOM_read_vector(CS%snap_file, 'uhtr_sum', 'vhtr_sum', CS%uhtr_all(:,:,1:CS%nk_input,t), & - CS%vhtr_all(:,:,1:CS%nk_input,t), CS%G%Domain, timelevel=t) - call MOM_read_data(CS%snap_file,'h_end', CS%hend_all(:,:,1:CS%nk_input,t), CS%G%Domain, & - timelevel=t, position=CENTER) - call MOM_read_data(CS%mean_file,'temp', CS%temp_all(:,:,1:CS%nk_input,t), CS%G%Domain, & - timelevel=t, position=CENTER) - call MOM_read_data(CS%mean_file,'salt', CS%salt_all(:,:,1:CS%nk_input,t), CS%G%Domain, & - timelevel=t, position=CENTER) + CS%vhtr_all(:,:,1:CS%nk_input,t), G%Domain, timelevel=t, & + scale=US%m_to_L**2*GV%kg_m2_to_H) + call MOM_read_data(CS%snap_file,'h_end', CS%hend_all(:,:,1:CS%nk_input,t), G%Domain, & + timelevel=t, position=CENTER, scale=GV%kg_m2_to_H) + call MOM_read_data(CS%mean_file,'temp', CS%temp_all(:,:,1:CS%nk_input,t), G%Domain, & + timelevel=t, position=CENTER) + call MOM_read_data(CS%mean_file,'salt', CS%salt_all(:,:,1:CS%nk_input,t), G%Domain, & + timelevel=t, position=CENTER) enddo endif From 112ac4998c806077b3b1d2f7d3eab54d322347a5 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 11 Dec 2021 06:07:47 -0500 Subject: [PATCH 20/73] +(*)Revised offline tracer algorithms Minorly revised the algorithms used for offline tracer advection for rotational consistency, and for exact reproducibility across PE layouts by using reproducing sums to detect convergence. This also includes some changes to use roundoff to detect convergence instead of fixed values. Also replaced some divisions with multiplication by a reciprocal. In addition, some of the optional arguments to advect_tracer that are only used for offline tracer advection were renamed or revised for clarity and reordered for the convenience of the non-offline-tracer code. Although answers with the offline tracer code will change slightly because of this refactoring, because of some bugs that were fixed in another recent commit, it was previously impossible to have run the offline tracer cases at all. All answers and output in the MOM6-examples regression suite are bitwise identical. --- src/tracer/MOM_offline_aux.F90 | 132 +++++++++++++++---------------- src/tracer/MOM_offline_main.F90 | 129 +++++++++++++++--------------- src/tracer/MOM_tracer_advect.F90 | 49 ++++++------ 3 files changed, 154 insertions(+), 156 deletions(-) diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index b370dd6bb4..f95f2cd40e 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -70,7 +70,7 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) ! Convert back to thickness - h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) + h_new(i,j,k) = h_new(i,j,k) * G%IareaT(i,j) enddo ; enddo enddo @@ -102,11 +102,11 @@ subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) do j=js-1,je+1 do i=is-1,ie+1 ! Top layer - h_new(i,j,1) = max(0.0, h_pre(i,j,1) + (eb(i,j,1) - ea(i,j,2) + ea(i,j,1) )) + h_new(i,j,1) = max(0.0, h_pre(i,j,1) + ((eb(i,j,1) - ea(i,j,2)) + ea(i,j,1))) h_new(i,j,1) = h_new(i,j,1) + max(0.0, 1.0e-13*h_new(i,j,1) - h_pre(i,j,1)) ! Bottom layer - h_new(i,j,nz) = max(0.0, h_pre(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)+eb(i,j,nz))) + h_new(i,j,nz) = max(0.0, h_pre(i,j,nz) + ((ea(i,j,nz) - eb(i,j,nz-1)) + eb(i,j,nz))) h_new(i,j,nz) = h_new(i,j,nz) + max(0.0, 1.0e-13*h_new(i,j,nz) - h_pre(i,j,nz)) enddo @@ -140,13 +140,15 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) !! step [H ~> m or kg m-2] ! Local variables - integer :: i, j, k, m, is, ie, js, je, nz - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: top_flux ! Net fluxes through the layer top [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: bottom_flux ! Net fluxes through the layer bottom [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: top_flux ! Net upward fluxes through the layer + ! top [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: bottom_flux ! Net downward fluxes through the layer + ! bottom [H ~> m or kg m-2] real :: pos_flux ! Net flux out of cell [H L2 ~> m3 or kg m-2] real :: hvol ! Cell volume [H L2 ~> m3 or kg m-2] real :: scale_factor ! A nondimensional rescaling factor between 0 and 1 [nondim] real :: max_off_cfl ! The maximum permitted fraction that can leave in a timestep [nondim] + integer :: i, j, k, m, is, ie, js, je, nz max_off_cfl = 0.5 @@ -182,46 +184,33 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 hvol = h_pre(i,j,k) * G%areaT(i,j) - pos_flux = max(0.0,-uh(I-1,j,k)) + max(0.0, -vh(i,J-1,k)) + & - max(0.0, uh(I,j,k)) + max(0.0, vh(i,J,k)) + & - max(0.0, top_flux(i,j,k)*G%areaT(i,j)) + max(0.0, bottom_flux(i,j,k)*G%areaT(i,j)) + pos_flux = ((max(0.0, -uh(I-1,j,k)) + max(0.0, uh(I,j,k))) + & + (max(0.0, -vh(i,J-1,k)) + max(0.0, vh(i,J,k)))) + & + (max(0.0, top_flux(i,j,k)) + max(0.0, bottom_flux(i,j,k))) * G%areaT(i,j) if (pos_flux>hvol .and. pos_flux>0.0) then - scale_factor = (hvol / pos_flux)*max_off_cfl + scale_factor = (hvol / pos_flux) * max_off_cfl else ! Don't scale scale_factor = 1.0 endif ! Scale horizontal fluxes - if (-uh(I-1,j,k)>0) uh(I-1,j,k) = uh(I-1,j,k)*scale_factor - if (uh(I,j,k)>0) uh(I,j,k) = uh(I,j,k)*scale_factor - if (-vh(i,J-1,k)>0) vh(i,J-1,k) = vh(i,J-1,k)*scale_factor - if (vh(i,J,k)>0) vh(i,J,k) = vh(i,J,k)*scale_factor - - if (k>1 .and. k0.0) then - ea(i,j,k) = ea(i,j,k)*scale_factor - eb(i,j,k-1) = eb(i,j,k-1)*scale_factor - endif - if (bottom_flux(i,j,k)>0.0) then - eb(i,j,k) = eb(i,j,k)*scale_factor - ea(i,j,k+1) = ea(i,j,k+1)*scale_factor - endif - ! Scale top layer - elseif (k==1) then - if (top_flux(i,j,k)>0.0) ea(i,j,k) = ea(i,j,k)*scale_factor - if (bottom_flux(i,j,k)>0.0) then - eb(i,j,k) = eb(i,j,k)*scale_factor - ea(i,j,k+1) = ea(i,j,k+1)*scale_factor - endif - ! Scale bottom layer - elseif (k==nz) then - if (top_flux(i,j,k)>0.0) then - ea(i,j,k) = ea(i,j,k)*scale_factor - eb(i,j,k-1) = eb(i,j,k-1)*scale_factor - endif - if (bottom_flux(i,j,k)>0.0) eb(i,j,k) = eb(i,j,k)*scale_factor + if (-uh(I-1,j,k) > 0.0) uh(I-1,j,k) = uh(I-1,j,k) * scale_factor + if (uh(I,j,k) > 0.0) uh(I,j,k) = uh(I,j,k) * scale_factor + if (-vh(i,J-1,k) > 0.0) vh(i,J-1,k) = vh(i,J-1,k) * scale_factor + if (vh(i,J,k) > 0.0) vh(i,J,k) = vh(i,J,k) * scale_factor + + ! Scale the flux across the interface atop a layer if it is upward + if (top_flux(i,j,k) > 0.0) then + ea(i,j,k) = ea(i,j,k) * scale_factor + if (k > 1) & + eb(i,j,k-1) = eb(i,j,k-1) * scale_factor + endif + ! Scale the flux across the interface atop a layer if it is downward + if (bottom_flux(i,j,k) > 0.0) then + eb(i,j,k) = eb(i,j,k) * scale_factor + if (k < nz) & + ea(i,j,k+1) = ea(i,j,k+1) * scale_factor endif enddo ; enddo ; enddo @@ -244,6 +233,8 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) real, dimension(SZI_(G),SZK_(GV)) :: h2d ! A 2-d slice of cell volumes [H L2 ~> m3 or kg] real, dimension(SZI_(G)) :: h2d_sum ! Vertically summed cell volumes [H L2 ~> m3 or kg] + real :: abs_uh_sum ! The vertical sum of the absolute value of the transports [H L2 ~> m3 or kg] + real :: new_uh_sum ! The vertically summed transports after redistribution [H L2 ~> m3 or kg] real :: uh_neglect ! A negligible transport [H L2 ~> m3 or kg] integer :: i, j, k, m, is, ie, js, je, nz @@ -253,7 +244,7 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) do j=js,je uh2d_sum(:) = 0.0 ! Copy over uh to a working array and sum up the remaining fluxes in a column - do k=1,nz ; do i=is-1,ie + do k=1,nz ; do I=is-1,ie uh2d(I,k) = uh(I,j,k) uh2d_sum(I) = uh2d_sum(I) + uh2d(I,k) enddo ; enddo @@ -265,13 +256,13 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) if (hvol(i,j,k)>0.) then h2d_sum(i) = h2d_sum(i) + h2d(i,k) else - h2d(i,k) = GV%H_subroundoff * 1.0*G%US%m_to_L**2 !### Change to G%areaT(i,j) + h2d(i,k) = GV%H_subroundoff * G%areaT(i,j) endif enddo ; enddo ! Distribute flux. Note min/max is intended to make sure that the mass transport ! does not deplete a cell - do i=is-1,ie + do I=is-1,ie if ( uh2d_sum(I)>0.0 ) then do k=1,nz uh2d(I,k) = uh2d_sum(I)*(h2d(i,k)/h2d_sum(i)) @@ -285,16 +276,20 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) uh2d(I,k) = 0.0 enddo endif - ! Calculate and check that column integrated transports match the original to - ! within the tolerance limit + + ! Check that column integrated transports match the original to within roundoff. uh_neglect = GV%Angstrom_H * min(G%areaT(i,j), G%areaT(i+1,j)) - ! ### This test may not work if GV%Angstrom_H is set to 0. - ! Instead try the max of this and ~roundoff compared with absolute transports? - if ( abs(sum(uh2d(I,:))-uh2d_sum(I)) > uh_neglect) & - call MOM_error(WARNING, "Column integral of uh does not match after barotropic redistribution") + abs_uh_sum = 0.0 ; new_uh_sum = 0.0 + do k=1,nz + abs_uh_sum = abs_uh_sum + abs(uh2d(j,k)) + new_uh_sum = new_uh_sum + uh2d(j,k) + enddo + if ( abs(new_uh_sum - uh2d_sum(j)) > max(uh_neglect, (5.0e-16*nz)*abs_uh_sum) ) & + call MOM_error(WARNING, "Column integral of uh does not match after "//& + "barotropic redistribution") enddo - do k=1,nz ; do i=is-1,ie + do k=1,nz ; do I=is-1,ie uh(I,j,k) = uh2d(I,k) enddo ; enddo enddo @@ -317,6 +312,8 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) real, dimension(SZJ_(G),SZK_(GV)) :: h2d ! A 2-d slice of cell volumes [H L2 ~> m3 or kg] real, dimension(SZJ_(G)) :: h2d_sum ! Vertically summed cell volumes [H L2 ~> m3 or kg] + real :: abs_vh_sum ! The vertical sum of the absolute value of the transports [H L2 ~> m3 or kg] + real :: new_vh_sum ! The vertically summed transports after redistribution [H L2 ~> m3 or kg] real :: vh_neglect ! A negligible transport [H L2 ~> m3 or kg] integer :: i, j, k, m, is, ie, js, je, nz @@ -326,7 +323,7 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) do i=is,ie vh2d_sum(:) = 0.0 ! Copy over uh to a working array and sum up the remaining fluxes in a column - do k=1,nz ; do j=js-1,je + do k=1,nz ; do J=js-1,je vh2d(J,k) = vh(i,J,k) vh2d_sum(J) = vh2d_sum(J) + vh2d(J,k) enddo ; enddo @@ -338,12 +335,12 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) if (hvol(i,j,k)>0.) then h2d_sum(j) = h2d_sum(j) + h2d(j,k) else - h2d(j,k) = GV%H_subroundoff * 1.0*G%US%m_to_L**2 !### Change to G%areaT(i,j) + h2d(i,k) = GV%H_subroundoff * G%areaT(i,j) endif enddo ; enddo ! Distribute flux evenly throughout a column - do j=js-1,je + do J=js-1,je if ( vh2d_sum(J)>0.0 ) then do k=1,nz vh2d(J,k) = vh2d_sum(J)*(h2d(j,k)/h2d_sum(j)) @@ -357,19 +354,20 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) vh2d(J,k) = 0.0 enddo endif - ! Calculate and check that column integrated transports match the original to - ! within the tolerance limit - vh_neglect = GV%Angstrom_H * min(G%areaT(i,j), G%areaT(i,j+1)) - ! ### This test may not work if GV%Angstrom_H is set to 0. - ! Instead try the max of this and ~roundoff compared with absolute transports? - if ( abs(sum(vh2d(J,:))-vh2d_sum(J)) > vh_neglect) then - call MOM_error(WARNING,"Column integral of vh does not match after "//& - "barotropic redistribution") - endif + ! Check that column integrated transports match the original to within roundoff. + vh_neglect = GV%Angstrom_H * min(G%areaT(i,j), G%areaT(i,j+1)) + abs_vh_sum = 0.0 ; new_vh_sum = 0.0 + do k=1,nz + abs_vh_sum = abs_vh_sum + abs(vh2d(J,k)) + new_vh_sum = new_vh_sum + vh2d(J,k) + enddo + if ( abs(new_vh_sum - vh2d_sum(J)) > max(vh_neglect, (5.0e-16*nz)*abs_vh_sum) ) & + call MOM_error(WARNING, "Column integral of vh does not match after "//& + "barotropic redistribution") enddo - do k=1,nz ; do j=js-1,je + do k=1,nz ; do J=js-1,je vh(i,J,k) = vh2d(J,k) enddo ; enddo enddo @@ -411,7 +409,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) h2d(i,k) = hvol(i,j,k) - min_h * G%areaT(i,j) enddo ; enddo - do i=is-1,ie + do I=is-1,ie uh_col = SUM(uh2d(I,:)) ! Store original column-integrated transport do k=1,nz uh_remain = uh2d(I,k) @@ -466,7 +464,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) enddo ! i-loop - do k=1,nz ; do i=is-1,ie + do k=1,nz ; do I=is-1,ie uh(I,j,k) = uh2d(I,k) enddo ; enddo enddo @@ -502,14 +500,14 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) do i=is,ie ! Copy over uh and cell volume to working arrays - do k=1,nz ; do j=js-2,je+1 + do k=1,nz ; do J=js-2,je+1 vh2d(J,k) = vh(i,J,k) enddo ; enddo do k=1,nz ; do j=js-1,je+1 h2d(j,k) = hvol(i,j,k) - min_h * G%areaT(i,j) enddo ; enddo - do j=js-1,je + do J=js-1,je vh_col = SUM(vh2d(J,:)) do k=1,nz vh_remain = vh2d(J,k) @@ -565,7 +563,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) endif enddo - do k=1,nz ; do j=js-1,je + do k=1,nz ; do J=js-1,je vh(i,J,k) = vh2d(J,k) enddo ; enddo enddo diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 72041fbc86..d5b3f708a3 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -6,6 +6,7 @@ module MOM_offline_main use MOM_ALE, only : ALE_CS, ALE_main_offline, ALE_offline_inputs use MOM_checksums, only : hchksum, uvchksum +use MOM_coms, only : reproducing_sum use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_SUBCOMPONENT use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE @@ -13,7 +14,7 @@ module MOM_offline_main use MOM_diabatic_driver, only : diabatic_CS, extract_diabatic_member use MOM_diabatic_aux, only : tridiagTS use MOM_diag_mediator, only : diag_ctrl, post_data, register_diag_field -use MOM_domains, only : sum_across_PEs, pass_var, pass_vector +use MOM_domains, only : pass_var, pass_vector use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING use MOM_error_handler, only : callTree_enter, callTree_leave use MOM_file_parser, only : read_param, get_param, log_version, param_file_type @@ -39,7 +40,6 @@ module MOM_offline_main implicit none ; private #include "MOM_memory.h" -#include "version_variable.h" !> The control structure for the offline transport module type, public :: offline_transport_CS ; private @@ -305,7 +305,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C call hchksum(h_pre, "h_pre before transport", G%HI, scale=GV%H_to_m) call uvchksum("[uv]htr_sub before transport", uhtr_sub, vhtr_sub, G%HI, scale=HL2_to_kg_scale) endif - tot_residual = remaining_transport_sum(G, GV, uhtr, vhtr) + tot_residual = remaining_transport_sum(G, GV, US, uhtr, vhtr, h_new) if (CS%print_adv_offline) then write(mesg,'(A,ES24.16)') "Main advection starting transport: ", tot_residual*HL2_to_kg_scale call MOM_mesg(mesg) @@ -328,15 +328,15 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C endif call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, CS%dt_offline, G, GV, US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=1, & - uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y) + CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_before_y, vol_prev=h_vol, & + max_iter_in=1, update_vol_prev=.true., uhr_out=uhtr, vhr_out=vhtr) ! Switch the direction every iteration x_before_y = .not. x_before_y ! Update the new layer thicknesses after one round of advection has happened do k=1,nz ; do j=js,je ; do i=is,ie - h_new(i,j,k) = h_new(i,j,k) / (G%areaT(i,j)) !### Replace with "* G%IareaT(i,j)" + h_new(i,j,k) = h_vol(i,j,k) * G%IareaT(i,j) enddo ; enddo ; enddo if (MODULO(iter,CS%off_ale_mod)==0) then @@ -367,7 +367,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C ! Check for whether we've used up all the advection, or if we need to move on because ! advection has stalled - tot_residual = remaining_transport_sum(G, GV, uhtr, vhtr) + tot_residual = remaining_transport_sum(G, GV, US, uhtr, vhtr, h_new) if (CS%print_adv_offline) then write(mesg,'(A,ES24.16)') "Main advection remaining transport: ", tot_residual*HL2_to_kg_scale call MOM_mesg(mesg) @@ -478,9 +478,6 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve call pass_var(h_vol,G%Domain) call pass_vector(uhtr, vhtr, G%Domain) - ! Store volumes for advect_tracer - h_pre(:,:,:) = h_vol(:,:,:) - if (CS%debug) then call MOM_tracer_chksum("Before upwards redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) @@ -495,8 +492,8 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve endif call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt=h_pre, max_iter_in=1, & - h_out=h_vol, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) + CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_before_y, vol_prev=h_vol, & + max_iter_in=1, update_vol_prev=.true., uhr_out=uhr, vhr_out=vhr) if (CS%debug) then call MOM_tracer_chksum("After upwards redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) @@ -506,7 +503,7 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve do k=1,nz ; do j=js,je ; do i=is,ie uhtr(I,j,k) = uhr(I,j,k) vhtr(i,J,k) = vhr(i,J,k) - h_new(i,j,k) = h_vol(i,j,k) / (G%areaT(i,j)) + h_new(i,j,k) = h_vol(i,j,k) * G%IareaT(i,j) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo @@ -522,9 +519,6 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve call pass_var(h_vol, G%Domain) call pass_vector(uhtr, vhtr, G%Domain) - ! Copy h_vol to h_pre for advect_tracer routine - h_pre(:,:,:) = h_vol(:,:,:) - if (CS%debug) then call MOM_tracer_chksum("Before barotropic redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI, scale=HL2_to_kg_scale) @@ -539,8 +533,8 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve endif call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt=h_pre, max_iter_in=1, & - h_out=h_vol, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) + CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_before_y, vol_prev=h_vol, & + max_iter_in=1, update_vol_prev=.true., uhr_out=uhr, vhr_out=vhr) if (CS%debug) then call MOM_tracer_chksum("After barotropic redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) @@ -550,14 +544,14 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve do k=1,nz ; do j=js,je ; do i=is,ie uhtr(I,j,k) = uhr(I,j,k) vhtr(i,J,k) = vhr(i,J,k) - h_new(i,j,k) = h_vol(i,j,k) / (G%areaT(i,j)) + h_new(i,j,k) = h_vol(i,j,k) * G%IareaT(i,j) h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo endif ! redistribute barotropic ! Check to see if all transport has been exhausted - tot_residual = remaining_transport_sum(G, GV, uhtr, vhtr) + tot_residual = remaining_transport_sum(G, GV, US, uhtr, vhtr, h_new) if (CS%print_adv_offline) then write(mesg,'(A,ES24.16)') "Residual advection remaining transport: ", tot_residual*HL2_to_kg_scale call MOM_mesg(mesg) @@ -597,39 +591,40 @@ subroutine offline_redistribute_residual(CS, G, GV, US, h_pre, uhtr, vhtr, conve end subroutine offline_redistribute_residual !> Returns the sums of any non-negligible remaining transport [H L2 ~> m3 or kg] to check for advection convergence -real function remaining_transport_sum(G, GV, uhtr, vhtr) +real function remaining_transport_sum(G, GV, US, uhtr, vhtr, h_new) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(in ) :: uhtr !< Zonal mass transport [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(in ) :: vhtr !< Meridional mass transport [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(in ) :: h_new !< Layer thicknesses [H ~> m or kg m-2] ! Local variables - integer :: i, j, k - integer :: is, ie, js, je, nz - real :: h_min !< A layer thickness below roundoff from GV type - real :: uh_neglect !< A small value of zonal transport that effectively is below roundoff error - real :: vh_neglect !< A small value of meridional transport that effectively is below roundoff error + real, dimension(SZI_(G),SZJ_(G)) :: trans_rem_col !< The vertical sum of the absolute value of + !! transports through the faces of a column, in MKS units [kg]. + real :: trans_cell !< The sum of the absolute value of the remaining transports through the faces + !! of a tracer cell [H L2 ~> m3 or kg] + real :: HL2_to_kg_scale !< Unit conversion factor to cell mass [kg H-1 L-2 ~> kg m-3 or 1] + integer :: i, j, k, is, ie, js, je, nz - nz = GV%ke - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - h_min = GV%H_subroundoff + HL2_to_kg_scale = GV%H_to_kg_m2 * US%L_to_m**2 - remaining_transport_sum = 0. + trans_rem_col(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - uh_neglect = h_min * MIN(G%areaT(i,j), G%areaT(i+1,j)) - vh_neglect = h_min * MIN(G%areaT(i,j), G%areaT(i,j+1)) - if (ABS(uhtr(I,j,k))>uh_neglect) then - remaining_transport_sum = remaining_transport_sum + ABS(uhtr(I,j,k)) - endif - if (ABS(vhtr(i,J,k))>vh_neglect) then - remaining_transport_sum = remaining_transport_sum + ABS(vhtr(i,J,k)) - endif + trans_cell = (ABS(uhtr(I-1,j,k)) + ABS(uhtr(I,j,k))) + & + (ABS(vhtr(i,J-1,k)) + ABS(vhtr(i,J,k))) + if (trans_cell > max(1.0e-16*h_new(i,j,k), GV%H_subroundoff) * G%areaT(i,j)) & + trans_rem_col(i,j) = trans_rem_col(i,j) + HL2_to_kg_scale * trans_cell enddo ; enddo ; enddo - !### The value of this sum is not layout independent. - call sum_across_PEs(remaining_transport_sum) + + ! The factor of 0.5 here is to avoid double-counting because two cells share a face. + remaining_transport_sum = 0.5 * GV%kg_m2_to_H*US%m_to_L**2 * & + reproducing_sum(trans_rem_col, is+(1-G%isd), ie+(1-G%isd), js+(1-G%jsd), je+(1-G%jsd)) end function remaining_transport_sum @@ -854,11 +849,14 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, ! Remaining meridional mass transports [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vhtr_sub - real :: sum_abs_fluxes, sum_u, sum_v ! Used to keep track of how close to convergence we are [H L2 ~> m3 or kg] - ! Vertical diffusion related variables [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJB_(G)) :: rem_col_flux ! The summed absolute value of the remaining + ! fluxes through the faces of a column or within a column, in mks units [kg] + real :: sum_flux ! Globally summed absolute value of fluxes in mks units [kg], which is + ! used to keep track of how close to convergence we are. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & - eatr_sub, & - ebtr_sub + eatr_sub, & ! Layer entrainment rate from above for this sub-cycle [H ~> m or kg m-2] + ebtr_sub ! Layer entrainment rate from below for this sub-cycle [H ~> m or kg m-2] ! Variables used to keep track of layer thicknesses at various points in the code real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & h_new, & ! Updated thicknesses [H ~> m or kg m-2] @@ -899,7 +897,6 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, vhtr_sub(i,J,k) = vhtr(i,J,k) enddo ; enddo ; enddo - ! Calculate 3d mass transports to be used in this iteration call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre) @@ -920,11 +917,11 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, h_vol(i,j,k) = h_pre(i,j,k) * G%areaT(i,j) enddo ; enddo ; enddo call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) + CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_before_y, vol_prev=h_vol, max_iter_in=30) ! Done with horizontal so now h_pre should be h_new do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 - h_pre(i,j,k) = h_new(i,j,k) + h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo endif @@ -936,12 +933,12 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 h_vol(i,j,k) = h_pre(i,j,k) * G%areaT(i,j) enddo ; enddo ; enddo - call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, US, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=30, x_first_in=x_before_y) + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, dt_iter, G, GV, US, CS%tracer_adv_CSp, & + CS%tracer_Reg, x_first_in=x_before_y, vol_prev=h_vol, max_iter_in=30) ! Done with horizontal so now h_pre should be h_new do k=1,nz ; do i=is-1,ie+1 ; do j=js-1,je+1 - h_pre(i,j,k) = h_new(i,j,k) + h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo ! Second vertical advection @@ -973,28 +970,25 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, G, GV, US, call pass_var(ebtr,G%Domain) call pass_var(h_pre,G%Domain) call pass_vector(uhtr,vhtr,G%Domain) - ! + ! Calculate how close we are to converging by summing the remaining fluxes at each point - sum_abs_fluxes = 0.0 - sum_u = 0.0 - sum_v = 0.0 + HL2_to_kg_scale = US%L_to_m**2*GV%H_to_kg_m2 + rem_col_flux(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - sum_u = sum_u + abs(uhtr(I-1,j,k))+abs(uhtr(I,j,k)) - sum_v = sum_v + abs(vhtr(i,J-1,k))+abs(vhtr(I,J,k)) - sum_abs_fluxes = sum_abs_fluxes + abs(eatr(i,j,k)) + abs(ebtr(i,j,k)) + abs(uhtr(I-1,j,k)) + & - abs(uhtr(I,j,k)) + abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k)) + rem_col_flux(i,j) = rem_col_flux(i,j) + HL2_to_kg_scale * & + ( (abs(eatr(i,j,k)) + abs(ebtr(i,j,k))) + & + ((abs(uhtr(I-1,j,k)) + abs(uhtr(I,j,k))) + & + (abs(vhtr(i,J-1,k)) + abs(vhtr(i,J,k))) ) ) enddo ; enddo ; enddo - call sum_across_PEs(sum_abs_fluxes) - - HL2_to_kg_scale = US%L_to_m**2*GV%H_to_kg_m2 + sum_flux = reproducing_sum(rem_col_flux, is+(1-G%isd), ie+(1-G%isd), js+(1-G%jsd), je+(1-G%jsd)) - write(mesg,*) "offline_advection_layer: Remaining u-flux, v-flux:", & - sum_u*HL2_to_kg_scale, sum_v*HL2_to_kg_scale - call MOM_mesg(mesg) - if (sum_abs_fluxes==0) then + if (sum_flux==0) then write(mesg,*) 'offline_advection_layer: Converged after iteration', iter call MOM_mesg(mesg) exit + else + write(mesg,*) "offline_advection_layer: Iteration ", iter, " remaining total fluxes: ", sum_flux + call MOM_mesg(mesg) endif ! Switch order of Strang split every iteration @@ -1321,7 +1315,8 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) character(len=40) :: mdl = "offline_transport" character(len=20) :: redistribute_method - + ! This include declares and sets the variable "version". +# include "version_variable.h" integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB @@ -1336,7 +1331,7 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) return endif allocate(CS) - call log_version(param_file, mdl,version, "This module allows for tracers to be run offline") + call log_version(param_file, mdl, version, "This module allows for tracers to be run offline") ! Parse MOM_input for offline control call get_param(param_file, mdl, "OFFLINEDIR", CS%offlinedir, & diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 1ad6343cf8..e2c669fcc7 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -47,36 +47,41 @@ module MOM_tracer_advect !> This routine time steps the tracer concentration using a !! monotonic, conservative, weakly diffusive scheme. -subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & - h_prev_opt, max_iter_in, x_first_in, uhr_out, vhr_out, h_out) +subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, x_first_in, & + vol_prev, max_iter_in, update_vol_prev, uhr_out, vhr_out) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h_end !< layer thickness after advection [H ~> m or kg m-2] + intent(in) :: h_end !< Layer thickness after advection [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: uhtr !< accumulated volume/mass flux through zonal face [H L2 ~> m3 or kg] + intent(in) :: uhtr !< Accumulated volume or mass flux through the + !! zonal faces [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - intent(in) :: vhtr !< accumulated volume/mass flux through merid face [H L2 ~> m3 or kg] + intent(in) :: vhtr !< Accumulated volume or mass flux through the + !! meridional faces [H L2 ~> m3 or kg] type(ocean_OBC_type), pointer :: OBC !< specifies whether, where, and what OBCs are used real, intent(in) :: dt !< time increment [T ~> s] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_advect_CS), pointer :: CS !< control structure for module type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(in) :: h_prev_opt !< Cell volume before advection [H L2 ~> m3 or kg] - integer, optional, intent(in) :: max_iter_in !< The maximum number of iterations logical, optional, intent(in) :: x_first_in !< If present, indicate whether to update !! first in the x- or y-direction. + ! The remaining optional arguments are only used in offline tracer mode. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + optional, intent(inout) :: vol_prev !< Cell volume before advection [H L2 ~> m3 or kg]. + !! If update_vol_prev is true, the returned value is + !! the cell volume after the transport that was done + !! by this call, and if all the transport could be + !! accommodated it should be close to h_end*G%areaT. + integer, optional, intent(in) :: max_iter_in !< The maximum number of iterations + logical, optional, intent(in) :: update_vol_prev !< If present and true, update vol_prev to + !! return its value after the tracer have been updated. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: uhr_out !< Remaining accumulated volume/mass flux through zonal face - !! [H L2 ~> m3 or kg] + optional, intent(out) :: uhr_out !< Remaining accumulated volume or mass fluxes + !! through the zonal faces [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - optional, intent(out) :: vhr_out !< Remaining accumulated volume/mass flux through meridional face - !! [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: h_out !< Cell volume after the transport that was done - !! by this call [H L2 ~> m3 or kg]. If all the transport - !! could be accommodated, this is close to h_end*G%areaT. + optional, intent(out) :: vhr_out !< Remaining accumulated volume or mass fluxes + !! through the meridional faces [H L2 ~> m3 or kg] type(tracer_type) :: Tr(MAX_FIELDS_) ! The array of registered tracers real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & @@ -137,9 +142,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & enddo call cpu_clock_end(id_clock_pass) -!$OMP parallel default(none) shared(nz,jsd,jed,IsdB,IedB,uhr,jsdB,jedB,Isd,Ied,vhr, & -!$OMP hprev,domore_k,js,je,is,ie,uhtr,vhtr,G,GV,h_end,& -!$OMP uh_neglect,vh_neglect,ntr,Tr,h_prev_opt) + !$OMP parallel default(shared) ! This initializes the halos of uhr and vhr because pass_vector might do ! calculations on them, even though they are never used. @@ -152,7 +155,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & ! Put the remaining (total) thickness fluxes into uhr and vhr. do j=js,je ; do I=is-1,ie ; uhr(I,j,k) = uhtr(I,j,k) ; enddo ; enddo do J=js-1,je ; do i=is,ie ; vhr(i,J,k) = vhtr(i,J,k) ; enddo ; enddo - if (.not. present(h_prev_opt)) then + if (.not. present(vol_prev)) then ! This loop reconstructs the thickness field the last time that the ! tracers were updated, probably just after the diabatic forcing. A useful ! diagnostic could be to compare this reconstruction with that older value. @@ -167,7 +170,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & enddo ; enddo else do i=is,ie ; do j=js,je - hprev(i,j,k) = h_prev_opt(i,j,k) + hprev(i,j,k) = vol_prev(i,j,k) enddo ; enddo endif enddo @@ -326,7 +329,9 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, & if (present(uhr_out)) uhr_out(:,:,:) = uhr(:,:,:) if (present(vhr_out)) vhr_out(:,:,:) = vhr(:,:,:) - if (present(h_out)) h_out(:,:,:) = hprev(:,:,:) + if (present(vol_prev) .and. present(update_vol_prev)) then + if (update_vol_prev) vol_prev(:,:,:) = hprev(:,:,:) + endif call cpu_clock_end(id_clock_advect) From cf931b1e42ae3b4de53a9c8e4dc3dd9a3bbec976 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 9 Dec 2021 03:28:11 -0500 Subject: [PATCH 21/73] Eliminate unneeded diagnostic arrays Eliminated 18 unnecessary 3-d allocatable arrays and 5 2-d allocatable arrays from the MOM_diagnostics control structure, replacing them with reused local stack arrays. Also collected the registration of time derivatives and the allocation of memory for intermediary diagnostics in set_dependent_diagnostics. All answers and output are bitwise identical. --- src/diagnostics/MOM_diagnostics.F90 | 530 +++++++++++----------------- 1 file changed, 206 insertions(+), 324 deletions(-) diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 9979ecb5b1..e06cb235c4 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -63,52 +63,12 @@ module MOM_diagnostics ! following arrays store diagnostics calculated here and unavailable outside. - ! following fields have nz+1 levels. - real, allocatable :: e(:,:,:) !< interface height [Z ~> m] - real, allocatable :: e_D(:,:,:) !< interface height above bottom [Z ~> m] - ! following fields have nz layers. real, allocatable :: du_dt(:,:,:) !< net i-acceleration [L T-2 ~> m s-2] real, allocatable :: dv_dt(:,:,:) !< net j-acceleration [L T-2 ~> m s-2] real, allocatable :: dh_dt(:,:,:) !< thickness rate of change [H T-1 ~> m s-1 or kg m-2 s-1] - real, allocatable :: p_ebt(:,:,:) !< Equivalent barotropic modal structure [nondim] - ! real, allocatable :: hf_du_dt(:,:,:), hf_dv_dt(:,:,:) !< du_dt, dv_dt x fract. thickness [L T-2 ~> m s-2]. - ! 3D diagnostics hf_du(dv)_dt are commented because there is no clarity on proper remapping grid option. - ! The code is retained for debugging purposes in the future. - - real, allocatable :: h_Rlay(:,:,:) !< Layer thicknesses in potential density - !! coordinates [H ~> m or kg m-2] - real, allocatable :: uh_Rlay(:,:,:) !< Zonal transports in potential density - !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] - real, allocatable :: vh_Rlay(:,:,:) !< Meridional transports in potential density - !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] - real, allocatable :: uhGM_Rlay(:,:,:) !< Zonal Gent-McWilliams transports in potential density - !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] - real, allocatable :: vhGM_Rlay(:,:,:) !< Meridional Gent-McWilliams transports in potential density - !! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1] - - ! following fields are 2-D. - real, allocatable :: cg1(:,:) !< First baroclinic gravity wave speed [L T-1 ~> m s-1] - real, allocatable :: Rd1(:,:) !< First baroclinic deformation radius [L ~> m] - real, allocatable :: cfl_cg1(:,:) !< CFL for first baroclinic gravity wave speed [nondim] - real, allocatable :: cfl_cg1_x(:,:) !< i-component of CFL for first baroclinic gravity wave speed [nondim] - real, allocatable :: cfl_cg1_y(:,:) !< j-component of CFL for first baroclinic gravity wave speed [nondim] - - ! The following arrays hold diagnostics in the layer-integrated energy budget. - real, allocatable :: KE(:,:,:) !< KE per unit mass [L2 T-2 ~> m2 s-2] - real, allocatable :: dKE_dt(:,:,:) !< time derivative of the layer KE [H L2 T-3 ~> m3 s-3] - real, allocatable :: PE_to_KE(:,:,:) !< potential energy to KE term [H L2 T-3 ~> m3 s-3] - real, allocatable :: KE_BT(:,:,:) !< barotropic contribution to KE term [H L2 T-3 ~> m3 s-3] - real, allocatable :: KE_CorAdv(:,:,:) !< KE source from the combined Coriolis and - !! advection terms [H L2 T-3 ~> m3 s-3]. - !! The Coriolis source should be zero, but is not due to truncation - !! errors. There should be near-cancellation of the global integral - !! of this spurious Coriolis source. - real, allocatable :: KE_adv(:,:,:) !< KE source from along-layer advection [H L2 T-3 ~> m3 s-3] - real, allocatable :: KE_visc(:,:,:) !< KE source from vertical viscosity [H L2 T-3 ~> m3 s-3] - real, allocatable :: KE_stress(:,:,:) !< KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3] - real, allocatable :: KE_horvisc(:,:,:) !< KE source from horizontal viscosity [H L2 T-3 ~> m3 s-3] - real, allocatable :: KE_dia(:,:,:) !< KE source from diapycnal diffusion [H L2 T-3 ~> m3 s-3] + + logical :: KE_term_on !< If true, at least one diagnostic term in the KE budget is in use. !>@{ Diagnostic IDs integer :: id_u = -1, id_v = -1, id_h = -1 @@ -233,10 +193,20 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb + real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! Interface heights, either relative to a reference + ! geopotential or the seafloor [Z ~> m]. real :: Rcv(SZI_(G),SZJ_(G),SZK_(GV)) ! Coordinate variable potential density [R ~> kg m-3]. - real :: work_3d(SZI_(G),SZJ_(G),SZK_(GV)) ! A 3-d temporary work array. + real :: work_3d(SZI_(G),SZJ_(G),SZK_(GV)) ! A 3-d temporary work array in various units + ! including [nondim] and [H ~> m or kg m-2]. + real :: uh_tmp(SZIB_(G),SZJ_(G),SZK_(GV)) ! A temporary zonal transport [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vh_tmp(SZI_(G),SZJB_(G),SZK_(GV)) ! A temporary meridional transport [H L2 T-1 ~> m3 s-1 or kg s-1] real :: work_2d(SZI_(G),SZJ_(G)) ! A 2-d temporary work array. real :: rho_in_situ(SZI_(G)) ! In situ density [R ~> kg m-3] + real :: cg1(SZI_(G),SZJ_(G)) ! First baroclinic gravity wave speed [L T-1 ~> m s-1] + real :: Rd1(SZI_(G),SZJ_(G)) ! First baroclinic deformation radius [L ~> m] + real :: CFL_cg1(SZI_(G),SZJ_(G)) ! CFL for first baroclinic gravity wave speed, either based on the + ! overall grid spacing or just one direction [nondim] + ! tmp array for surface properties real :: surface_field(SZI_(G),SZJ_(G)) @@ -330,32 +300,32 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call post_data(CS%id_uv, uv, CS%diag) endif - if (allocated(CS%e)) then - call find_eta(h, tv, G, GV, US, CS%e, dZref=G%Z_ref) - if (CS%id_e > 0) call post_data(CS%id_e, CS%e, CS%diag) - endif - - if (allocated(CS%e_D)) then - if (allocated(CS%e)) then + ! Find the interface heights, relative either to a reference height or to the bottom [Z ~> m]. + if (CS%id_e > 0) then + call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) + if (CS%id_e > 0) call post_data(CS%id_e, eta, CS%diag) + if (CS%id_e_D > 0) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - CS%e_D(i,j,k) = CS%e(i,j,k) + (G%bathyT(i,j) + G%Z_ref) - enddo ; enddo ; enddo - else - call find_eta(h, tv, G, GV, US, CS%e_D) - do k=1,nz+1 ; do j=js,je ; do i=is,ie - CS%e_D(i,j,k) = CS%e_D(i,j,k) + G%bathyT(i,j) + eta(i,j,k) = eta(i,j,k) + (G%bathyT(i,j) + G%Z_ref) enddo ; enddo ; enddo + call post_data(CS%id_e_D, eta, CS%diag) endif - - if (CS%id_e_D > 0) call post_data(CS%id_e_D, CS%e_D, CS%diag) + elseif (CS%id_e_D > 0) then + call find_eta(h, tv, G, GV, US, eta) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + eta(i,j,k) = eta(i,j,k) + G%bathyT(i,j) + enddo ; enddo ; enddo + call post_data(CS%id_e_D, eta, CS%diag) endif - ! mass per area of grid cell (for Bouss, use Rho0) + ! mass per area of grid cell (for Boussinesq, use Rho0) if (CS%id_masscello > 0) then do k=1,nz ; do j=js,je ; do i=is,ie work_3d(i,j,k) = GV%H_to_kg_m2*h(i,j,k) enddo ; enddo ; enddo call post_data(CS%id_masscello, work_3d, CS%diag) + !### If the registration call has conversion=GV%H_to_kg, the mathematically equivalent form would be: + ! call post_data(CS%id_masscello, h, CS%diag) endif ! mass of liquid ocean (for Bouss, use Rho0). The reproducing sum requires the use of MKS units. @@ -500,9 +470,9 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & call calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) - if ((CS%id_Rml > 0) .or. (CS%id_Rcv > 0) .or. allocated(CS%h_Rlay) .or. & - allocated(CS%uh_Rlay) .or. allocated(CS%vh_Rlay) .or. & - allocated(CS%uhGM_Rlay) .or. allocated(CS%vhGM_Rlay)) then + if ((CS%id_Rml > 0) .or. (CS%id_Rcv > 0) .or. (CS%id_h_Rlay > 0) .or. & + (CS%id_uh_Rlay > 0) .or. (CS%id_vh_Rlay > 0) .or. & + (CS%id_uhGM_Rlay > 0) .or. (CS%id_vhGM_Rlay > 0)) then if (associated(tv%eqn_of_state)) then EOSdom(:) = EOS_domain(G%HI, halo=1) @@ -520,110 +490,112 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if (CS%id_Rml > 0) call post_data(CS%id_Rml, Rcv, CS%diag) if (CS%id_Rcv > 0) call post_data(CS%id_Rcv, Rcv, CS%diag) - if (allocated(CS%h_Rlay)) then + if (CS%id_h_Rlay > 0) then + ! Here work_3d is used for the layer thicknesses in potential density coordinates [H ~> m or kg m-2]. k_list = nz/2 -!$OMP parallel do default(none) shared(is,ie,js,je,nz,nkmb,CS,Rcv,h,GV) & -!$OMP private(wt,wt_p) firstprivate(k_list) + !$OMP parallel do default(shared) private(wt,wt_p) firstprivate(k_list) do j=js,je do k=1,nkmb ; do i=is,ie - CS%h_Rlay(i,j,k) = 0.0 + work_3d(i,j,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do i=is,ie - CS%h_Rlay(i,j,k) = h(i,j,k) + work_3d(i,j,k) = h(i,j,k) enddo ; enddo do k=1,nkmb ; do i=is,ie call find_weights(GV%Rlay, Rcv(i,j,k), k_list, nz, wt, wt_p) - CS%h_Rlay(i,j,k_list) = CS%h_Rlay(i,j,k_list) + h(i,j,k)*wt - CS%h_Rlay(i,j,k_list+1) = CS%h_Rlay(i,j,k_list+1) + h(i,j,k)*wt_p + work_3d(i,j,k_list) = work_3d(i,j,k_list) + h(i,j,k)*wt + work_3d(i,j,k_list+1) = work_3d(i,j,k_list+1) + h(i,j,k)*wt_p enddo ; enddo enddo - if (CS%id_h_Rlay > 0) call post_data(CS%id_h_Rlay, CS%h_Rlay, CS%diag) + call post_data(CS%id_h_Rlay, work_3d, CS%diag) endif - if (allocated(CS%uh_Rlay)) then + if (CS%id_uh_Rlay > 0) then + ! Calculate zonal transports in potential density coordinates [H L2 T-1 ~> m3 s-1 or kg s-1]. k_list = nz/2 -!$OMP parallel do default(none) shared(Isq,Ieq,js,je,nz,nkmb,Rcv,CS,GV,uh) & -!$OMP private(wt,wt_p) firstprivate(k_list) + !$OMP parallel do default(shared) private(wt,wt_p) firstprivate(k_list) do j=js,je do k=1,nkmb ; do I=Isq,Ieq - CS%uh_Rlay(I,j,k) = 0.0 + uh_tmp(I,j,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do I=Isq,Ieq - CS%uh_Rlay(I,j,k) = uh(I,j,k) + uh_tmp(I,j,k) = uh(I,j,k) enddo ; enddo k_list = nz/2 do k=1,nkmb ; do I=Isq,Ieq call find_weights(GV%Rlay, 0.5*(Rcv(i,j,k)+Rcv(i+1,j,k)), k_list, nz, wt, wt_p) - CS%uh_Rlay(I,j,k_list) = CS%uh_Rlay(I,j,k_list) + uh(I,j,k)*wt - CS%uh_Rlay(I,j,k_list+1) = CS%uh_Rlay(I,j,k_list+1) + uh(I,j,k)*wt_p + uh_tmp(I,j,k_list) = uh_tmp(I,j,k_list) + uh(I,j,k)*wt + uh_tmp(I,j,k_list+1) = uh_tmp(I,j,k_list+1) + uh(I,j,k)*wt_p enddo ; enddo enddo - if (CS%id_uh_Rlay > 0) call post_data(CS%id_uh_Rlay, CS%uh_Rlay, CS%diag) + call post_data(CS%id_uh_Rlay, uh_tmp, CS%diag) endif - if (allocated(CS%vh_Rlay)) then + if (CS%id_vh_Rlay > 0) then + ! Calculate meridional transports in potential density coordinates [H L2 T-1 ~> m3 s-1 or kg s-1]. k_list = nz/2 -!$OMP parallel do default(none) shared(Jsq,Jeq,is,ie,nz,nkmb,Rcv,CS,GV,vh) & -!$OMP private(wt,wt_p) firstprivate(k_list) + !$OMP parallel do default(shared) private(wt,wt_p) firstprivate(k_list) do J=Jsq,Jeq do k=1,nkmb ; do i=is,ie - CS%vh_Rlay(i,J,k) = 0.0 + vh_tmp(i,J,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do i=is,ie - CS%vh_Rlay(i,J,k) = vh(i,J,k) + vh_tmp(i,J,k) = vh(i,J,k) enddo ; enddo do k=1,nkmb ; do i=is,ie call find_weights(GV%Rlay, 0.5*(Rcv(i,j,k)+Rcv(i,j+1,k)), k_list, nz, wt, wt_p) - CS%vh_Rlay(i,J,k_list) = CS%vh_Rlay(i,J,k_list) + vh(i,J,k)*wt - CS%vh_Rlay(i,J,k_list+1) = CS%vh_Rlay(i,J,k_list+1) + vh(i,J,k)*wt_p + vh_tmp(i,J,k_list) = vh_tmp(i,J,k_list) + vh(i,J,k)*wt + vh_tmp(i,J,k_list+1) = vh_tmp(i,J,k_list+1) + vh(i,J,k)*wt_p enddo ; enddo enddo - if (CS%id_vh_Rlay > 0) call post_data(CS%id_vh_Rlay, CS%vh_Rlay, CS%diag) + call post_data(CS%id_vh_Rlay, vh_tmp, CS%diag) endif - if (allocated(CS%uhGM_Rlay) .and. associated(CDp%uhGM)) then + if ((CS%id_uhGM_Rlay > 0) .and. associated(CDp%uhGM)) then + ! Calculate zonal Gent-McWilliams transports in potential density + ! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1]. k_list = nz/2 -!$OMP parallel do default(none) shared(Isq,Ieq,js,je,nz,nkmb,Rcv,CDP,CS,GV) & -!$OMP private(wt,wt_p) firstprivate(k_list) + !$OMP parallel do default(shared) private(wt,wt_p) firstprivate(k_list) do j=js,je do k=1,nkmb ; do I=Isq,Ieq - CS%uhGM_Rlay(I,j,k) = 0.0 + uh_tmp(I,j,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do I=Isq,Ieq - CS%uhGM_Rlay(I,j,k) = CDp%uhGM(I,j,k) + uh_tmp(I,j,k) = CDp%uhGM(I,j,k) enddo ; enddo do k=1,nkmb ; do I=Isq,Ieq call find_weights(GV%Rlay, 0.5*(Rcv(i,j,k)+Rcv(i+1,j,k)), k_list, nz, wt, wt_p) - CS%uhGM_Rlay(I,j,k_list) = CS%uhGM_Rlay(I,j,k_list) + CDp%uhGM(I,j,k)*wt - CS%uhGM_Rlay(I,j,k_list+1) = CS%uhGM_Rlay(I,j,k_list+1) + CDp%uhGM(I,j,k)*wt_p + uh_tmp(I,j,k_list) = uh_tmp(I,j,k_list) + CDp%uhGM(I,j,k)*wt + uh_tmp(I,j,k_list+1) = uh_tmp(I,j,k_list+1) + CDp%uhGM(I,j,k)*wt_p enddo ; enddo enddo - if (CS%id_uhGM_Rlay > 0) call post_data(CS%id_uhGM_Rlay, CS%uhGM_Rlay, CS%diag) + if (CS%id_uhGM_Rlay > 0) call post_data(CS%id_uhGM_Rlay, uh_tmp, CS%diag) endif - if (allocated(CS%vhGM_Rlay) .and. associated(CDp%vhGM)) then + if ((CS%id_vhGM_Rlay > 0) .and. associated(CDp%vhGM)) then + ! Calculate meridional Gent-McWilliams transports in potential density + ! coordinates [H L2 T-1 ~> m3 s-1 or kg s-1]. k_list = nz/2 -!$OMP parallel do default(none) shared(is,ie,Jsq,Jeq,nz,nkmb,CS,CDp,Rcv,GV) & -!$OMP private(wt,wt_p) firstprivate(k_list) + !$OMP parallel do default(shared) private(wt,wt_p) firstprivate(k_list) do J=Jsq,Jeq do k=1,nkmb ; do i=is,ie - CS%vhGM_Rlay(i,J,k) = 0.0 + vh_tmp(i,J,k) = 0.0 enddo ; enddo do k=nkmb+1,nz ; do i=is,ie - CS%vhGM_Rlay(i,J,k) = CDp%vhGM(i,J,k) + vh_tmp(i,J,k) = CDp%vhGM(i,J,k) enddo ; enddo do k=1,nkmb ; do i=is,ie call find_weights(GV%Rlay, 0.5*(Rcv(i,j,k)+Rcv(i,j+1,k)), k_list, nz, wt, wt_p) - CS%vhGM_Rlay(i,J,k_list) = CS%vhGM_Rlay(i,J,k_list) + CDp%vhGM(i,J,k)*wt - CS%vhGM_Rlay(i,J,k_list+1) = CS%vhGM_Rlay(i,J,k_list+1) + CDp%vhGM(i,J,k)*wt_p + vh_tmp(i,J,k_list) = vh_tmp(i,J,k_list) + CDp%vhGM(i,J,k)*wt + vh_tmp(i,J,k_list+1) = vh_tmp(i,J,k_list+1) + CDp%vhGM(i,J,k)*wt_p enddo ; enddo enddo - if (CS%id_vhGM_Rlay > 0) call post_data(CS%id_vhGM_Rlay, CS%vhGM_Rlay, CS%diag) + if (CS%id_vhGM_Rlay > 0) call post_data(CS%id_vhGM_Rlay, vh_tmp, CS%diag) endif endif @@ -680,8 +652,8 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & if ((CS%id_cg1>0) .or. (CS%id_Rd1>0) .or. (CS%id_cfl_cg1>0) .or. & (CS%id_cfl_cg1_x>0) .or. (CS%id_cfl_cg1_y>0)) then - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed) - if (CS%id_cg1>0) call post_data(CS%id_cg1, CS%cg1, CS%diag) + call wave_speed(h, tv, G, GV, US, cg1, CS%wave_speed) + if (CS%id_cg1>0) call post_data(CS%id_cg1, cg1, CS%diag) if (CS%id_Rd1>0) then !$OMP parallel do default(shared) private(f2_h,mag_beta) do j=js,je ; do i=is,ie @@ -694,42 +666,44 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2) )) - CS%Rd1(i,j) = CS%cg1(i,j) / sqrt(f2_h + CS%cg1(i,j) * mag_beta) + Rd1(i,j) = cg1(i,j) / sqrt(f2_h + cg1(i,j) * mag_beta) enddo ; enddo - call post_data(CS%id_Rd1, CS%Rd1, CS%diag) + call post_data(CS%id_Rd1, Rd1, CS%diag) endif if (CS%id_cfl_cg1>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1(i,j) = (dt*CS%cg1(i,j)) * (G%IdxT(i,j) + G%IdyT(i,j)) + CFL_cg1(i,j) = (dt*cg1(i,j)) * (G%IdxT(i,j) + G%IdyT(i,j)) enddo ; enddo - call post_data(CS%id_cfl_cg1, CS%cfl_cg1, CS%diag) + call post_data(CS%id_cfl_cg1, CFL_cg1, CS%diag) endif if (CS%id_cfl_cg1_x>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1_x(i,j) = (dt*CS%cg1(i,j)) * G%IdxT(i,j) + CFL_cg1(i,j) = (dt*cg1(i,j)) * G%IdxT(i,j) enddo ; enddo - call post_data(CS%id_cfl_cg1_x, CS%cfl_cg1_x, CS%diag) + call post_data(CS%id_cfl_cg1_x, CFL_cg1, CS%diag) endif if (CS%id_cfl_cg1_y>0) then do j=js,je ; do i=is,ie - CS%cfl_cg1_y(i,j) = (dt*CS%cg1(i,j)) * G%IdyT(i,j) + CFL_cg1(i,j) = (dt*cg1(i,j)) * G%IdyT(i,j) enddo ; enddo - call post_data(CS%id_cfl_cg1_y, CS%cfl_cg1_y, CS%diag) + call post_data(CS%id_cfl_cg1_y, CFL_cg1, CS%diag) endif endif if ((CS%id_cg_ebt>0) .or. (CS%id_Rd_ebt>0) .or. (CS%id_p_ebt>0)) then if (CS%id_p_ebt>0) then - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed, use_ebt_mode=.true., & + ! Here work_3d is used for the equivalent barotropic modal structure [nondim]. + work_3d(:,:,:) = 0.0 + call wave_speed(h, tv, G, GV, US, cg1, CS%wave_speed, use_ebt_mode=.true., & mono_N2_column_fraction=CS%mono_N2_column_fraction, & - mono_N2_depth=CS%mono_N2_depth, modal_structure=CS%p_ebt) - call post_data(CS%id_p_ebt, CS%p_ebt, CS%diag) + mono_N2_depth=CS%mono_N2_depth, modal_structure=work_3d) + call post_data(CS%id_p_ebt, work_3d, CS%diag) else - call wave_speed(h, tv, G, GV, US, CS%cg1, CS%wave_speed, use_ebt_mode=.true., & + call wave_speed(h, tv, G, GV, US, cg1, CS%wave_speed, use_ebt_mode=.true., & mono_N2_column_fraction=CS%mono_N2_column_fraction, & mono_N2_depth=CS%mono_N2_depth) endif - if (CS%id_cg_ebt>0) call post_data(CS%id_cg_ebt, CS%cg1, CS%diag) + if (CS%id_cg_ebt>0) call post_data(CS%id_cg_ebt, cg1, CS%diag) if (CS%id_Rd_ebt>0) then !$OMP parallel do default(shared) private(f2_h,mag_beta) do j=js,je ; do i=is,ie @@ -742,10 +716,10 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2) )) - CS%Rd1(i,j) = CS%cg1(i,j) / sqrt(f2_h + CS%cg1(i,j) * mag_beta) + Rd1(i,j) = cg1(i,j) / sqrt(f2_h + cg1(i,j) * mag_beta) enddo ; enddo - call post_data(CS%id_Rd_ebt, CS%Rd1, CS%diag) + call post_data(CS%id_Rd_ebt, Rd1, CS%diag) endif endif @@ -762,8 +736,8 @@ subroutine find_weights(Rlist, R_in, k, nz, wt, wt_p) integer, intent(inout) :: k !< The value of k such that Rlist(k) <= R_in < Rlist(k+1) !! The input value is a first guess integer, intent(in) :: nz !< The number of layers in Rlist - real, intent(out) :: wt !< The weight of layer k for interpolation, nondim - real, intent(out) :: wt_p !< The weight of layer k+1 for interpolation, nondim + real, intent(out) :: wt !< The weight of layer k for interpolation [nondim] + real, intent(out) :: wt_p !< The weight of layer k+1 for interpolation [nondim] ! This subroutine finds location of R_in in an increasing ordered ! list, Rlist, returning as k the element such that @@ -960,41 +934,39 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by a previous call to !! diagnostics_init. -! This subroutine calculates terms in the mechanical energy budget. - ! Local variables - real :: KE_u(SZIB_(G),SZJ_(G)) - real :: KE_v(SZI_(G),SZJB_(G)) - real :: KE_h(SZI_(G),SZJ_(G)) + real :: KE(SZI_(G),SZJ_(G),SZK_(GV)) ! Kinetic energy per unit mass [L2 T-2 ~> m2 s-2] + real :: KE_term(SZI_(G),SZJ_(G),SZK_(GV)) ! A term in the kinetic energy budget + ! [H L2 T-3 ~> m3 s-3 or W m-2] + real :: KE_u(SZIB_(G),SZJ_(G)) ! The area integral of a KE term in a layer at u-points + ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3] + real :: KE_v(SZI_(G),SZJB_(G)) ! The area integral of a KE term in a layer at v-points + ! [H L4 T-3 ~> m5 s-3 or kg m2 s-3] + real :: KE_h(SZI_(G),SZJ_(G)) ! A KE term contribution at tracer points + ! [H L2 T-3 ~> m3 s-3 or W m-2] integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + if (.not.(CS%KE_term_on .or. (CS%id_KE > 0))) return + do j=js-1,je ; do i=is-1,ie KE_u(I,j) = 0.0 ; KE_v(i,J) = 0.0 enddo ; enddo - if (allocated(CS%KE)) then - do k=1,nz ; do j=js,je ; do i=is,ie - CS%KE(i,j,k) = ((u(I,j,k) * u(I,j,k) + u(I-1,j,k) * u(I-1,j,k)) & - + (v(i,J,k) * v(i,J,k) + v(i,J-1,k) * v(i,J-1,k))) * 0.25 - ! DELETE THE FOLLOWING... Make this 0 to test the momentum balance, - ! or a huge number to test the continuity balance. - ! CS%KE(i,j,k) *= 1e20 - enddo ; enddo ; enddo - if (CS%id_KE > 0) call post_data(CS%id_KE, CS%KE, CS%diag) - endif + do k=1,nz ; do j=js,je ; do i=is,ie + KE(i,j,k) = ((u(I,j,k) * u(I,j,k) + u(I-1,j,k) * u(I-1,j,k)) & + + (v(i,J,k) * v(i,J,k) + v(i,J-1,k) * v(i,J-1,k))) * 0.25 + enddo ; enddo ; enddo + if (CS%id_KE > 0) call post_data(CS%id_KE, KE, CS%diag) - if (.not.G%symmetric) then - if (allocated(CS%dKE_dt) .OR. allocated(CS%PE_to_KE) .OR. allocated(CS%KE_BT) .OR. & - allocated(CS%KE_CorAdv) .OR. allocated(CS%KE_adv) .OR. allocated(CS%KE_visc) .OR. & - allocated(CS%KE_horvisc) .OR. allocated(CS%KE_dia) ) then - call create_group_pass(CS%pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East) - endif + if (CS%KE_term_on .and. .not.G%symmetric) then + call create_group_pass(CS%pass_KE_uv, KE_u, KE_v, G%Domain, To_North+To_East) endif - if (allocated(CS%dKE_dt)) then + if (CS%id_dKEdt > 0) then + ! Calculate the time derivative of the layer KE [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * CS%du_dt(I,j,k) @@ -1003,19 +975,20 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * CS%dv_dt(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - KE_h(i,j) = CS%KE(i,j,k) * CS%dh_dt(i,j,k) + KE_h(i,j) = KE(i,j,k) * CS%dh_dt(i,j,k) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%dKE_dt(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_dKEdt > 0) call post_data(CS%id_dKEdt, CS%dKE_dt, CS%diag) + call post_data(CS%id_dKEdt, KE_term, CS%diag) endif - if (allocated(CS%PE_to_KE)) then + if (CS%id_PE_to_KE > 0) then + ! Calculate the potential energy to KE term [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%PFu(I,j,k) @@ -1026,14 +999,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%PE_to_KE(i,j,k) = 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_PE_to_KE > 0) call post_data(CS%id_PE_to_KE, CS%PE_to_KE, CS%diag) + if (CS%id_PE_to_KE > 0) call post_data(CS%id_PE_to_KE, KE_term, CS%diag) endif - if (allocated(CS%KE_BT)) then + if (CS%id_KE_BT > 0) then + ! Calculate the barotropic contribution to KE term [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%u_accel_bt(I,j,k) @@ -1044,14 +1018,17 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_BT(i,j,k) = 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_KE_BT > 0) call post_data(CS%id_KE_BT, CS%KE_BT, CS%diag) + call post_data(CS%id_KE_BT, KE_term, CS%diag) endif - if (allocated(CS%KE_CorAdv)) then + if (CS%id_KE_Coradv > 0) then + ! Calculate the KE source from the combined Coriolis and advection terms [H L2 T-3 ~> m3 s-3]. + ! The Coriolis source should be zero, but is not due to truncation errors. There should be + ! near-cancellation of the global integral of this spurious Coriolis source. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%CAu(I,j,k) @@ -1060,21 +1037,22 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * ADp%CAv(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - KE_h(i,j) = -CS%KE(i,j,k) * G%IareaT(i,j) & + KE_h(i,j) = -KE(i,j,k) * G%IareaT(i,j) & * (uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_CorAdv(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_KE_Coradv > 0) call post_data(CS%id_KE_Coradv, CS%KE_Coradv, CS%diag) + call post_data(CS%id_KE_Coradv, KE_term, CS%diag) endif - if (allocated(CS%KE_adv)) then - ! NOTE: All terms in KE_adv are multipled by -1, which can easily produce + if (CS%id_KE_adv > 0) then + ! Calculate the KE source from along-layer advection [H L2 T-3 ~> m3 s-3]. + ! NOTE: All terms in KE_adv are multiplied by -1, which can easily produce ! negative zeros and may signal a reproducibility issue over land. ! We resolve this by re-initializing and only evaluating over water points. KE_u(:,:) = 0. ; KE_v(:,:) = 0. @@ -1088,20 +1066,21 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * ADp%gradKEv(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - KE_h(i,j) = -CS%KE(i,j,k) * G%IareaT(i,j) & + KE_h(i,j) = -KE(i,j,k) * G%IareaT(i,j) & * (uh(I,j,k) - uh(I-1,j,k) + vh(i,J,k) - vh(i,J-1,k)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_adv(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_KE_adv > 0) call post_data(CS%id_KE_adv, CS%KE_adv, CS%diag) + call post_data(CS%id_KE_adv, KE_term, CS%diag) endif - if (allocated(CS%KE_visc)) then + if (CS%id_KE_visc > 0) then + ! Calculate the KE source from vertical viscosity [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_visc(I,j,k) @@ -1112,14 +1091,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_visc(i,j,k) = 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_KE_visc > 0) call post_data(CS%id_KE_visc, CS%KE_visc, CS%diag) + call post_data(CS%id_KE_visc, KE_term, CS%diag) endif - if (allocated(CS%KE_stress)) then + if (CS%id_KE_stress > 0) then + ! Calculate the KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_str(I,j,k) @@ -1130,14 +1110,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_stress(i,j,k) = 0.5 * G%IareaT(i,j) * & + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) * & ((KE_u(I,j) + KE_u(I-1,j)) + (KE_v(i,J) + KE_v(i,J-1))) enddo ; enddo enddo - if (CS%id_KE_stress > 0) call post_data(CS%id_KE_stress, CS%KE_stress, CS%diag) + call post_data(CS%id_KE_stress, KE_term, CS%diag) endif - if (allocated(CS%KE_horvisc)) then + if (CS%id_KE_horvisc > 0) then + ! Calculate the KE source from horizontal viscosity [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%diffu(I,j,k) @@ -1148,14 +1129,15 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_horvisc(i,j,k) = 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_KE_horvisc > 0) call post_data(CS%id_KE_horvisc, CS%KE_horvisc, CS%diag) + call post_data(CS%id_KE_horvisc, KE_term, CS%diag) endif - if (allocated(CS%KE_dia)) then + if (CS%id_KE_dia > 0) then + ! Calculate the KE source from diapycnal diffusion [H L2 T-3 ~> m3 s-3]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_dia(I,j,k) @@ -1164,16 +1146,16 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS KE_v(i,J) = vh(i,J,k) * G%dyCv(i,J) * ADp%dv_dt_dia(i,J,k) enddo ; enddo do j=js,je ; do i=is,ie - KE_h(i,j) = CS%KE(i,j,k) * (CDp%diapyc_vel(i,j,k) - CDp%diapyc_vel(i,j,k+1)) + KE_h(i,j) = KE(i,j,k) * (CDp%diapyc_vel(i,j,k) - CDp%diapyc_vel(i,j,k+1)) enddo ; enddo if (.not.G%symmetric) & call do_group_pass(CS%pass_KE_uv, G%domain) do j=js,je ; do i=is,ie - CS%KE_dia(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & + KE_term(i,j,k) = KE_h(i,j) + 0.5 * G%IareaT(i,j) & * (KE_u(I,j) + KE_u(I-1,j) + KE_v(i,J) + KE_v(i,J-1)) enddo ; enddo enddo - if (CS%id_KE_dia > 0) call post_data(CS%id_KE_dia, CS%KE_dia, CS%diag) + call post_data(CS%id_KE_dia, KE_term, CS%diag) endif end subroutine calculate_energy_diagnostics @@ -1456,7 +1438,7 @@ subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dy real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_tend ! Change in layer thickness due to dynamics ! [H T-1 ~> m s-1 or kg m-2 s-1]. real :: Idt ! The inverse of the time interval [T-1 ~> s-1] - real :: H_to_RZ_dt ! A conversion factor from accumulated transports to fluxes + real :: H_to_RZ_dt ! A conversion factor from accumulated transports to fluxes ! [R Z H-1 T-1 ~> kg m-3 s-1 or s-1]. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -1516,7 +1498,7 @@ subroutine post_transport_diagnostics(G, GV, US, uhtr, vhtr, h, IDs, diag_pre_dy end subroutine post_transport_diagnostics !> This subroutine registers various diagnostics and allocates space for fields -!! that other diagnostis depend upon. +!! that other diagnostics depend upon. subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag, CS, tv) type(ocean_internal_state), intent(in) :: MIS !< For "MOM Internal State" a set of pointers to !! the fields and accelerations that make up the @@ -1537,32 +1519,26 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag !! thermodynamic variables. ! Local variables - real :: omega, f2_min, convert_H - ! This include declares and sets the variable "version". -# include "version_variable.h" - character(len=40) :: mdl = "MOM_diagnostics" ! This module's name. - character(len=48) :: thickness_units, flux_units real :: wave_speed_min ! A floor in the first mode speed below which 0 is returned [L T-1 ~> m s-1] real :: wave_speed_tol ! The fractional tolerance for finding the wave speeds [nondim] + real :: convert_H ! A conversion factor from internal thickness units to the appropriate + ! MKS units (m or kg m-2) for thicknesses depending on whether the + ! Boussinesq approximation is being made [m H-1 or kg m-2 H-1 ~> 1] logical :: better_speed_est ! If true, use a more robust estimate of the first ! mode wave speed as the starting point for iterations. logical :: split ! True if using the barotropic-baroclinic split algorithm + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=40) :: mdl = "MOM_diagnostics" ! This module's name. + character(len=48) :: thickness_units, flux_units logical :: use_temperature, adiabatic logical :: default_2018_answers, remap_answers_2018 - integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, nkml, nkbl - integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB CS%initialized = .true. CS%diag => diag use_temperature = associated(tv%T) - call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., & - do_not_log=.true.) + call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., do_not_log=.true.) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -1600,7 +1576,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag endif CS%id_masscello = register_diag_field('ocean_model', 'masscello', diag%axesTL,& - Time, 'Mass per unit area of liquid ocean grid cell', 'kg m-2', & + Time, 'Mass per unit area of liquid ocean grid cell', 'kg m-2', & !### , conversion=GV%H_to_kg_m2, & standard_name='sea_water_mass_per_unit_area', v_extensive=.true.) CS%id_masso = register_scalar_field('ocean_model', 'masso', Time, & @@ -1677,11 +1653,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_e = register_diag_field('ocean_model', 'e', diag%axesTi, Time, & 'Interface Height Relative to Mean Sea Level', 'm', conversion=US%Z_to_m) - if (CS%id_e > 0) allocate(CS%e(isd:ied,jsd:jed,nz+1), source=0.) - CS%id_e_D = register_diag_field('ocean_model', 'e_D', diag%axesTi, Time, & 'Interface Height above the Seafloor', 'm', conversion=US%Z_to_m) - if (CS%id_e_D > 0) allocate(CS%e_D(isd:ied,jsd:jed,nz+1), source=0.) CS%id_Rml = register_diag_field('ocean_model', 'Rml', diag%axesTL, Time, & 'Mixed Layer Coordinate Potential Density', 'kg m-3', conversion=US%R_to_kg_m3) @@ -1702,115 +1675,54 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_du_dt = register_diag_field('ocean_model', 'dudt', diag%axesCuL, Time, & 'Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - if ((CS%id_du_dt>0) .and. .not. allocated(CS%du_dt)) then - allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) - call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) - endif CS%id_dv_dt = register_diag_field('ocean_model', 'dvdt', diag%axesCvL, Time, & 'Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - if ((CS%id_dv_dt>0) .and. .not. allocated(CS%dv_dt)) then - allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) - call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) - endif CS%id_dh_dt = register_diag_field('ocean_model', 'dhdt', diag%axesTL, Time, & 'Thickness tendency', trim(thickness_units)//" s-1", conversion=convert_H*US%s_to_T, v_extensive=.true.) - if ((CS%id_dh_dt>0) .and. .not. allocated(CS%dh_dt)) then - allocate(CS%dh_dt(isd:ied,jsd:jed,nz), source=0.) - call register_time_deriv(lbound(MIS%h), MIS%h, CS%dh_dt, CS) - endif !CS%id_hf_du_dt = register_diag_field('ocean_model', 'hf_dudt', diag%axesCuL, Time, & ! 'Fractional Thickness-weighted Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2, & ! v_extensive=.true.) - !if (CS%id_hf_du_dt > 0) then - ! call safe_alloc_ptr(CS%hf_du_dt,IsdB,IedB,jsd,jed,nz) - ! if (.not. allocated(CS%du_dt)) then - ! allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) - ! call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) - ! endif - ! call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) - !endif !CS%id_hf_dv_dt = register_diag_field('ocean_model', 'hf_dvdt', diag%axesCvL, Time, & ! 'Fractional Thickness-weighted Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2, & ! v_extensive=.true.) - !if (CS%id_hf_dv_dt > 0) then - ! call safe_alloc_ptr(CS%hf_dv_dt,isd,ied,JsdB,JedB,nz) - ! if (.not. allocated(CS%dv_dt)) then - ! allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) - ! call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) - ! endif - ! call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - !endif CS%id_hf_du_dt_2d = register_diag_field('ocean_model', 'hf_dudt_2d', diag%axesCu1, Time, & 'Depth-sum Fractional Thickness-weighted Zonal Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_hf_du_dt_2d > 0) then - if (.not. allocated(CS%du_dt)) then - allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) - call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) - endif - call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) - endif CS%id_hf_dv_dt_2d = register_diag_field('ocean_model', 'hf_dvdt_2d', diag%axesCv1, Time, & 'Depth-sum Fractional Thickness-weighted Meridional Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_hf_dv_dt_2d > 0) then - if (.not. allocated(CS%dv_dt)) then - allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) - call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) - endif - call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - endif CS%id_h_du_dt = register_diag_field('ocean_model', 'h_du_dt', diag%axesCuL, Time, & 'Thickness Multiplied Zonal Acceleration', 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_h_du_dt > 0) then - if (.not. allocated(CS%du_dt)) then - allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) - call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) - endif - call safe_alloc_ptr(ADp%diag_hu,IsdB,IedB,jsd,jed,nz) - endif CS%id_h_dv_dt = register_diag_field('ocean_model', 'h_dv_dt', diag%axesCvL, Time, & 'Thickness Multiplied Meridional Acceleration', 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_h_dv_dt > 0) then - if (.not. allocated(CS%dv_dt)) then - allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) - call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) - endif - call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) - endif ! layer thickness variables !if (GV%nk_rho_varies > 0) then CS%id_h_Rlay = register_diag_field('ocean_model', 'h_rho', diag%axesTL, Time, & 'Layer thicknesses in pure potential density coordinates', & thickness_units, conversion=convert_H) - if (CS%id_h_Rlay > 0) allocate(CS%h_Rlay(isd:ied,jsd:jed,nz), source=0.) CS%id_uh_Rlay = register_diag_field('ocean_model', 'uh_rho', diag%axesCuL, Time, & 'Zonal volume transport in pure potential density coordinates', & flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_uh_Rlay > 0) allocate(CS%uh_Rlay(IsdB:IedB,jsd:jed,nz), source=0.) CS%id_vh_Rlay = register_diag_field('ocean_model', 'vh_rho', diag%axesCvL, Time, & 'Meridional volume transport in pure potential density coordinates', & flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_vh_Rlay > 0) allocate(CS%vh_Rlay(isd:ied,JsdB:JedB,nz), source=0.) CS%id_uhGM_Rlay = register_diag_field('ocean_model', 'uhGM_rho', diag%axesCuL, Time, & 'Zonal volume transport due to interface height diffusion in pure potential '//& 'density coordinates', flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_uhGM_Rlay>0) allocate(CS%uhGM_Rlay(IsdB:IedB,jsd:jed,nz), source=0.) CS%id_vhGM_Rlay = register_diag_field('ocean_model', 'vhGM_rho', diag%axesCvL, Time, & 'Meridional volume transport due to interface height diffusion in pure potential '//& 'density coordinates', flux_units, conversion=US%L_to_m**2*US%s_to_T*convert_H) - if (CS%id_vhGM_Rlay>0) allocate(CS%vhGM_Rlay(isd:ied,JsdB:JedB,nz), source=0.) !endif @@ -1818,55 +1730,36 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag CS%id_KE = register_diag_field('ocean_model', 'KE', diag%axesTL, Time, & 'Layer kinetic energy per unit mass', & 'm2 s-2', conversion=US%L_T_to_m_s**2) - if (CS%id_KE > 0) allocate(CS%KE(isd:ied,jsd:jed,nz), source=0.) - CS%id_dKEdt = register_diag_field('ocean_model', 'dKE_dt', diag%axesTL, Time, & 'Kinetic Energy Tendency of Layer', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_dKEdt > 0) allocate(CS%dKE_dt(isd:ied,jsd:jed,nz), source=0.) - CS%id_PE_to_KE = register_diag_field('ocean_model', 'PE_to_KE', diag%axesTL, Time, & 'Potential to Kinetic Energy Conversion of Layer', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_PE_to_KE > 0) allocate(CS%PE_to_KE(isd:ied,jsd:jed,nz), source=0.) - if (split) then CS%id_KE_BT = register_diag_field('ocean_model', 'KE_BT', diag%axesTL, Time, & 'Barotropic contribution to Kinetic Energy', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_BT > 0) allocate(CS%KE_BT(isd:ied,jsd:jed,nz), source=0.) endif - CS%id_KE_Coradv = register_diag_field('ocean_model', 'KE_Coradv', diag%axesTL, Time, & 'Kinetic Energy Source from Coriolis and Advection', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_Coradv > 0) allocate(CS%KE_Coradv(isd:ied,jsd:jed,nz), source=0.) - CS%id_KE_adv = register_diag_field('ocean_model', 'KE_adv', diag%axesTL, Time, & 'Kinetic Energy Source from Advection', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_adv > 0) allocate(CS%KE_adv(isd:ied,jsd:jed,nz), source=0.) - CS%id_KE_visc = register_diag_field('ocean_model', 'KE_visc', diag%axesTL, Time, & 'Kinetic Energy Source from Vertical Viscosity and Stresses', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_visc > 0) allocate(CS%KE_visc(isd:ied,jsd:jed,nz), source=0.) - CS%id_KE_stress = register_diag_field('ocean_model', 'KE_stress', diag%axesTL, Time, & 'Kinetic Energy Source from Surface Stresses or Body Wind Stress', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_stress > 0) allocate(CS%KE_stress(isd:ied,jsd:jed,nz), source=0.) - CS%id_KE_horvisc = register_diag_field('ocean_model', 'KE_horvisc', diag%axesTL, Time, & 'Kinetic Energy Source from Horizontal Viscosity', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_horvisc > 0) allocate(CS%KE_horvisc(isd:ied,jsd:jed,nz), source=0.) - if (.not. adiabatic) then CS%id_KE_dia = register_diag_field('ocean_model', 'KE_dia', diag%axesTL, Time, & 'Kinetic Energy Source from Diapycnal Diffusion', & 'm3 s-3', conversion=GV%H_to_m*(US%L_T_to_m_s**2)*US%s_to_T) - if (CS%id_KE_dia > 0) allocate(CS%KE_dia(isd:ied,jsd:jed,nz), source=0.) endif ! gravity wave CFLs @@ -1893,13 +1786,6 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag call wave_speed_init(CS%wave_speed, remap_answers_2018=remap_answers_2018, & better_speed_est=better_speed_est, min_speed=wave_speed_min, & wave_speed_tol=wave_speed_tol) -!### call wave_speed_init(CS%wave_speed, remap_answers_2018=remap_answers_2018) - allocate(CS%cg1(isd:ied,jsd:jed), source=0.) - if (CS%id_Rd1 > 0 .or. CS%id_Rd_ebt > 0) allocate(CS%Rd1(isd:ied,jsd:jed), source=0.) - if (CS%id_cfl_cg1 > 0) allocate(CS%cfl_cg1(isd:ied,jsd:jed), source=0.) - if (CS%id_cfl_cg1_x > 0) allocate(CS%cfl_cg1_x(isd:ied,jsd:jed), source=0.) - if (CS%id_cfl_cg1_y > 0) allocate(CS%cfl_cg1_y(isd:ied,jsd:jed), source=0.) - if (CS%id_p_ebt > 0) allocate(CS%p_ebt(isd:ied,jsd:jed,nz), source=0.) endif CS%id_mass_wt = register_diag_field('ocean_model', 'mass_wt', diag%axesT1, Time, & @@ -1928,6 +1814,8 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag long_name='Sea Water Pressure at Sea Floor', standard_name='sea_water_pressure_at_sea_floor', & units='Pa', conversion=US%RL2_T2_to_Pa) + ! Register time derivatives and allocate memory for diagnostics that need + ! access from across several modules. call set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) end subroutine MOM_diagnostics_init @@ -2253,55 +2141,66 @@ subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, GV, CS) type(diagnostics_CS), intent(inout) :: CS !< Pointer to the control structure for this !! module. -! This subroutine sets up diagnostics upon which other diagnostics depend. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - if (allocated(CS%dKE_dt) .or. allocated(CS%PE_to_KE) .or. & - allocated(CS%KE_BT) .or. allocated(CS%KE_CorAdv) .or. & - allocated(CS%KE_adv) .or. allocated(CS%KE_visc) .or. allocated(CS%KE_stress) .or. & - allocated(CS%KE_horvisc) .or. allocated(CS%KE_dia)) then - if (.not. allocated(CS%KE)) allocate(CS%KE(isd:ied,jsd:jed,nz), source=0.) + ! Allocate and register time derivatives. + if ( ( (CS%id_du_dt>0) .or. (CS%id_dKEdt > 0) .or. & + ! (CS%id_hf_du_dt > 0) .or. & + (CS%id_h_du_dt > 0) .or. (CS%id_hf_du_dt_2d > 0) ) .and. & + (.not. allocated(CS%du_dt)) ) then + allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) + call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) endif - - if (allocated(CS%dKE_dt)) then - if (.not. allocated(CS%du_dt)) then - allocate(CS%du_dt(IsdB:IedB,jsd:jed,nz), source=0.) - call register_time_deriv(lbound(MIS%u), MIS%u, CS%du_dt, CS) - endif - if (.not. allocated(CS%dv_dt)) then - allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) - call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) - endif - if (.not. allocated(CS%dh_dt)) then - allocate(CS%dh_dt(isd:ied,jsd:jed,nz), source=0.) - call register_time_deriv(lbound(MIS%h), MIS%h, CS%dh_dt, CS) - endif + if ( ( (CS%id_dv_dt>0) .or. (CS%id_dKEdt > 0) .or. & + ! (CS%id_hf_dv_dt > 0) .or. & + (CS%id_h_dv_dt > 0) .or. (CS%id_hf_dv_dt_2d > 0) ) .and. & + (.not. allocated(CS%dv_dt)) ) then + allocate(CS%dv_dt(isd:ied,JsdB:JedB,nz), source=0.) + call register_time_deriv(lbound(MIS%v), MIS%v, CS%dv_dt, CS) + endif + if ( ( (CS%id_dh_dt>0) .or. (CS%id_dKEdt > 0) ) .and. & + (.not. allocated(CS%dh_dt)) ) then + allocate(CS%dh_dt(isd:ied,jsd:jed,nz), source=0.) + call register_time_deriv(lbound(MIS%h), MIS%h, CS%dh_dt, CS) endif - if (allocated(CS%KE_adv)) then + ! Allocate memory for other dependent diagnostics. + if (CS%id_KE_adv > 0) then call safe_alloc_ptr(ADp%gradKEu,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%gradKEv,isd,ied,JsdB,JedB,nz) endif - if (allocated(CS%KE_visc)) then + if (CS%id_KE_visc > 0) then call safe_alloc_ptr(ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_visc,isd,ied,JsdB,JedB,nz) endif - if (allocated(CS%KE_stress)) then + if (CS%id_KE_stress > 0) then call safe_alloc_ptr(ADp%du_dt_str,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_str,isd,ied,JsdB,JedB,nz) endif - if (allocated(CS%KE_dia)) then + if (CS%id_KE_dia > 0) then call safe_alloc_ptr(ADp%du_dt_dia,IsdB,IedB,jsd,jed,nz) call safe_alloc_ptr(ADp%dv_dt_dia,isd,ied,JsdB,JedB,nz) call safe_alloc_ptr(CDp%diapyc_vel,isd,ied,jsd,jed,nz+1) endif - if (allocated(CS%uhGM_Rlay)) call safe_alloc_ptr(CDp%uhGM,IsdB,IedB,jsd,jed,nz) - if (allocated(CS%vhGM_Rlay)) call safe_alloc_ptr(CDp%vhGM,isd,ied,JsdB,JedB,nz) + CS%KE_term_on = ((CS%id_dKEdt > 0) .or. (CS%id_PE_to_KE > 0) .or. (CS%id_KE_BT > 0) .or. & + (CS%id_KE_Coradv > 0) .or. (CS%id_KE_adv > 0) .or. (CS%id_KE_visc > 0) .or. & + (CS%id_KE_stress > 0) .or. (CS%id_KE_horvisc > 0) .or. (CS%id_KE_dia > 0)) + + if (CS%id_h_du_dt > 0) call safe_alloc_ptr(ADp%diag_hu,IsdB,IedB,jsd,jed,nz) + if (CS%id_h_dv_dt > 0) call safe_alloc_ptr(ADp%diag_hv,isd,ied,JsdB,JedB,nz) + + if (CS%id_hf_du_dt_2d > 0) call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) + if (CS%id_hf_dv_dt_2d > 0) call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) + ! if (CS%id_hf_du_dt > 0) call safe_alloc_ptr(ADp%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) + ! if (CS%id_hf_dv_dt > 0) call safe_alloc_ptr(ADp%diag_hfrac_v,isd,ied,JsdB,JedB,nz) + + if (CS%id_uhGM_Rlay > 0) call safe_alloc_ptr(CDp%uhGM,IsdB,IedB,jsd,jed,nz) + if (CS%id_vhGM_Rlay > 0) call safe_alloc_ptr(CDp%vhGM,isd,ied,JsdB,JedB,nz) end subroutine set_dependent_diagnostics @@ -2315,26 +2214,9 @@ subroutine MOM_diagnostics_end(CS, ADp, CDp) !! equation. integer :: m - if (allocated(CS%e)) deallocate(CS%e) - if (allocated(CS%e_D)) deallocate(CS%e_D) - if (allocated(CS%KE)) deallocate(CS%KE) - if (allocated(CS%dKE_dt)) deallocate(CS%dKE_dt) - if (allocated(CS%PE_to_KE)) deallocate(CS%PE_to_KE) - if (allocated(CS%KE_BT)) deallocate(CS%KE_BT) - if (allocated(CS%KE_Coradv)) deallocate(CS%KE_Coradv) - if (allocated(CS%KE_adv)) deallocate(CS%KE_adv) - if (allocated(CS%KE_visc)) deallocate(CS%KE_visc) - if (allocated(CS%KE_stress)) deallocate(CS%KE_stress) - if (allocated(CS%KE_horvisc)) deallocate(CS%KE_horvisc) - if (allocated(CS%KE_dia)) deallocate(CS%KE_dia) if (allocated(CS%dh_dt)) deallocate(CS%dh_dt) if (allocated(CS%dv_dt)) deallocate(CS%dv_dt) if (allocated(CS%du_dt)) deallocate(CS%du_dt) - if (allocated(CS%h_Rlay)) deallocate(CS%h_Rlay) - if (allocated(CS%uh_Rlay)) deallocate(CS%uh_Rlay) - if (allocated(CS%vh_Rlay)) deallocate(CS%vh_Rlay) - if (allocated(CS%uhGM_Rlay)) deallocate(CS%uhGM_Rlay) - if (allocated(CS%vhGM_Rlay)) deallocate(CS%vhGM_Rlay) if (associated(ADp%gradKEu)) deallocate(ADp%gradKEu) if (associated(ADp%gradKEv)) deallocate(ADp%gradKEv) From 170fffd14441097d8b077066b3deb3b19925647c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 9 Dec 2021 03:31:03 -0500 Subject: [PATCH 22/73] MOM_sponge cleanup Use the proper conversion factor for the w_sponge diagnostic, eliminated some unnecessary local copies of the domain sizes in the sponge control structure, and added more detailed descriptions of some of the variables in this module. All answers and output are bitwise identical. --- src/parameterizations/vertical/MOM_sponge.F90 | 62 +++++++------------ 1 file changed, 21 insertions(+), 41 deletions(-) diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 2699e57099..d0d64079c3 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -42,14 +42,6 @@ module MOM_sponge logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with !! nkml sublayers and nkbl buffer layer. integer :: nz !< The total number of layers. - integer :: isc !< The starting i-index of the computational domain at h. - integer :: iec !< The ending i-index of the computational domain at h. - integer :: jsc !< The starting j-index of the computational domain at h. - integer :: jec !< The ending j-index of the computational domain at h. - integer :: isd !< The starting i-index of the data domain at h. - integer :: ied !< The ending i-index of the data domain at h. - integer :: jsd !< The starting j-index of the data domain at h. - integer :: jed !< The ending j-index of the data domain at h. integer :: num_col !< The number of sponge points within the computational domain. integer :: fldno = 0 !< The number of fields which have already been !! registered by calls to set_up_sponge_field @@ -80,11 +72,10 @@ module MOM_sponge contains -!> This subroutine determines the number of points which are within -!! sponges in this computational domain. Only points that have -!! positive values of Iresttime and which mask2dT indicates are ocean -!! points are included in the sponges. It also stores the target interface -!! heights. +!> This subroutine determines the number of points which are within sponges in +!! this computational domain. Only points that have positive values of +!! Iresttime and which mask2dT indicates are ocean points are included in the +!! sponges. It also stores the target interface heights. subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & Iresttime_i_mean, int_height_i_mean) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure @@ -104,8 +95,8 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & !! damp the zonal mean heights [Z ~> m]. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_sponge" ! This module's name. logical :: use_sponge integer :: i, j, k, col, total_sponge_cols @@ -134,8 +125,7 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & CS%do_i_mean_sponge = present(Iresttime_i_mean) CS%nz = GV%ke -! CS%isc = G%isc ; CS%iec = G%iec ; CS%jsc = G%jsc ; CS%jec = G%jec -! CS%isd = G%isd ; CS%ied = G%ied ; CS%jsd = G%jsd ; CS%jed = G%jed + ! CS%bulkmixedlayer may be set later via a call to set_up_sponge_ML_density. CS%bulkmixedlayer = .false. @@ -203,13 +193,12 @@ subroutine init_sponge_diags(Time, G, GV, US, diag, CS) CS%diag => diag CS%id_w_sponge = register_diag_field('ocean_model', 'w_sponge', diag%axesTi, & - Time, 'The diapycnal motion due to the sponges', 'm s-1', conversion=US%s_to_T) + Time, 'The diapycnal motion due to the sponges', 'm s-1', conversion=GV%H_to_m*US%s_to_T) end subroutine init_sponge_diags -!> This subroutine stores the reference profile for the variable -!! whose address is given by f_ptr. nlay is the number of layers in -!! this variable. +!> This subroutine stores the reference profile for the variable whose +!! address is given by f_ptr. nlay is the number of layers in this variable. subroutine set_up_sponge_field(sp_val, f_ptr, G, GV, nlay, CS, sp_val_i_mean) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -261,8 +250,8 @@ subroutine set_up_sponge_field(sp_val, f_ptr, G, GV, nlay, CS, sp_val_i_mean) if (.not.present(sp_val_i_mean)) call MOM_error(FATAL, & "set_up_sponge_field: sp_val_i_mean must be present with i-mean sponges.") - allocate(CS%Ref_val_im(CS%fldno)%p(CS%jsd:CS%jed,CS%nz), source=0.0) - do k=1,CS%nz ; do j=CS%jsc,CS%jec + allocate(CS%Ref_val_im(CS%fldno)%p(G%jsd:G%jed,CS%nz), source=0.0) + do k=1,CS%nz ; do j=G%jsc,G%jec CS%Ref_val_im(CS%fldno)%p(j,k) = sp_val_i_mean(j,k) enddo ; enddo endif @@ -278,16 +267,10 @@ subroutine set_up_sponge_ML_density(sp_val, G, CS, sp_val_i_mean) intent(in) :: sp_val !< The reference values of the mixed layer density [R ~> kg m-3] type(sponge_CS), pointer :: CS !< A pointer to the control structure for this module that is !! set by a previous call to initialize_sponge. + ! The contents of this structure are intent(inout) here. real, dimension(SZJ_(G)), & optional, intent(in) :: sp_val_i_mean !< the reference values of the zonal mean mixed !! layer density [R ~> kg m-3], for use if Iresttime_i_mean > 0. -! This subroutine stores the reference value for mixed layer density. It is -! handled differently from other values because it is only used in determining -! which layers can be inflated. - -! Arguments: sp_val - The reference values of the mixed layer density. -! (in/out) CS - A pointer to the control structure for this module that is -! set by a previous call to initialize_sponge. integer :: j, col character(len=256) :: mesg ! String for error messages @@ -309,8 +292,8 @@ subroutine set_up_sponge_ML_density(sp_val, G, CS, sp_val_i_mean) if (.not.present(sp_val_i_mean)) call MOM_error(FATAL, & "set_up_sponge_field: sp_val_i_mean must be present with i-mean sponges.") - allocate(CS%Rcv_ml_ref_im(CS%jsd:CS%jed), source=0.0) - do j=CS%jsc,CS%jec + allocate(CS%Rcv_ml_ref_im(G%jsd:G%jed), source=0.0) + do j=G%jsc,G%jec CS%Rcv_ml_ref_im(j) = sp_val_i_mean(j) enddo endif @@ -339,10 +322,6 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml) real, dimension(SZI_(G),SZJ_(G)), & optional, intent(inout) :: Rcv_ml !< The coordinate density of the mixed layer [R ~> kg m-3]. -! This subroutine applies damping to the layers thicknesses, mixed -! layer buoyancy, and a variety of tracers for every column where -! there is damping. - ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: & w_int, & ! Water moved upward across an interface within a timestep, @@ -369,17 +348,18 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml) real :: e0 ! The height of the free surface [Z ~> m]. real :: e_str ! A nondimensional amount by which the reference ! profile must be stretched for the free surfaces - ! heights in the two profiles to agree. + ! heights in the two profiles to agree [nondim]. real :: w ! The thickness of water moving upward through an ! interface within 1 timestep [H ~> m or kg m-2]. real :: wm ! wm is w if w is negative and 0 otherwise [H ~> m or kg m-2]. real :: wb ! w at the interface below a layer [H ~> m or kg m-2]. real :: wpb ! wpb is wb if wb is positive and 0 otherwise [H ~> m or kg m-2]. - real :: ea_k, eb_k ! [H ~> m or kg m-2] - real :: damp ! The timestep times the local damping coefficient [nondim]. + real :: ea_k ! Water entrained from above within a timestep [H ~> m or kg m-2] + real :: eb_k ! Water entrained from below within a timestep [H ~> m or kg m-2] + real :: damp ! The timestep times the local damping coefficient [nondim]. real :: I1pdamp ! I1pdamp is 1/(1 + damp). [nondim] real :: damp_1pdamp ! damp_1pdamp is damp/(1 + damp). [nondim] - real :: Idt ! 1.0/dt times a height unit conversion factor [m H-1 T-1 ~> s-1 or m3 kg-1 s-1]. + real :: Idt ! The inverse of the timestep [T-1 ~> s-1] integer :: c, m, nkmb, i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -575,7 +555,7 @@ subroutine apply_sponge(h, dt, G, GV, US, ea, eb, CS, Rcv_ml) if (associated(CS%diag)) then ; if (query_averaging_enabled(CS%diag)) then if (CS%id_w_sponge > 0) then - Idt = GV%H_to_m / dt ! Do any height unit conversion here for efficiency. + Idt = 1.0 / dt do k=1,nz+1 ; do j=js,je ; do i=is,ie w_int(i,j,K) = w_int(i,j,K) * Idt ! Scale values by clobbering array since it is local enddo ; enddo ; enddo From 6feadd083b7d7260d30bd0224a1e405c33a61b6c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 11 Dec 2021 08:03:41 -0500 Subject: [PATCH 23/73] Use G%Rad_Earth_L in mct and NUOPC cap code Modified the two lines where the mct and NUOPC caps were using G%Rad_Earth to instead use G%Rad_Earth_L, and cancelled out the dimensional rescaling factors on these lines that are no longer appropriate. All answers should be bitwise identical, but because this change is to code that is not routinely exercised by testing with MOM6-examples, extra care should be taken in assessing these changes. --- config_src/drivers/mct_cap/ocn_comp_mct.F90 | 2 +- config_src/drivers/nuopc_cap/mom_cap.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/drivers/mct_cap/ocn_comp_mct.F90 b/config_src/drivers/mct_cap/ocn_comp_mct.F90 index 1872fff335..2f7deaa716 100644 --- a/config_src/drivers/mct_cap/ocn_comp_mct.F90 +++ b/config_src/drivers/mct_cap/ocn_comp_mct.F90 @@ -722,7 +722,7 @@ subroutine ocn_domain_mct( lsize, gsMap_ocn, dom_ocn) call mct_gGrid_importRattr(dom_ocn,"lat",data,lsize) k = 0 - L2_to_rad2 = grid%US%L_to_m**2 / grid%Rad_Earth**2 + L2_to_rad2 = 1.0 / grid%Rad_Earth_L**2 do j = grid%jsc, grid%jec do i = grid%isc, grid%iec k = k + 1 ! Increment position within gindex diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index ee498f4184..857505867c 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -1111,7 +1111,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) k = k + 1 ! Increment position within gindex if (mask(k) /= 0) then mesh_areas(k) = dataPtr_mesh_areas(k) - model_areas(k) = ocean_grid%US%L_to_m**2 * ocean_grid%AreaT(i,j) / ocean_grid%Rad_Earth**2 + model_areas(k) = ocean_grid%AreaT(i,j) / ocean_grid%Rad_Earth_L**2 mod2med_areacor(k) = model_areas(k) / mesh_areas(k) med2mod_areacor(k) = mesh_areas(k) / model_areas(k) end if From bbb975393619e7b0fbad5d0279a770fc65763342 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 11 Dec 2021 10:29:54 -0500 Subject: [PATCH 24/73] +Rescale some sea-surface height variables to [Z] Rescaled the units of four internal sea surface height or related variables in MOM.F90 and three sea surface height arguments to post_surface_dyn_diags and post_surface_thermo_diags from [m] to [Z ~> m]. Also added a few comments describing variables in MOM_diagnostics.F90. All answers, diagnostics, and output are bitwise identical. --- src/core/MOM.F90 | 34 ++++++++++++++---------- src/diagnostics/MOM_diagnostics.F90 | 40 +++++++++++++++++------------ 2 files changed, 45 insertions(+), 29 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 0e036d9d8f..db114ac3fa 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -188,10 +188,10 @@ module MOM vh, & !< vh = v * h * dx at v grid points [H L2 T-1 ~> m3 s-1 or kg s-1] vhtr !< accumulated meridional thickness fluxes to advect tracers [H L2 ~> m3 or kg] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ssh_rint - !< A running time integral of the sea surface height [T m ~> s m]. + !< A running time integral of the sea surface height [T Z ~> s m]. real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: ave_ssh_ibc !< time-averaged (over a forcing time step) sea surface height - !! with a correction for the inverse barometer [m] + !! with a correction for the inverse barometer [Z ~> m] real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_av_bc !< free surface height or column mass time averaged over the last !! baroclinic dynamics time step [H ~> m or kg m-2] @@ -515,7 +515,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS logical :: therm_reset ! If true, reset running sums of thermodynamic quantities. real :: cycle_time ! The length of the coupled time-stepping cycle [T ~> s]. real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: & - ssh ! sea surface height, which may be based on eta_av [m] + ssh ! sea surface height, which may be based on eta_av [Z ~> m] real, dimension(:,:,:), pointer :: & u => NULL(), & ! u : zonal velocity component [L T-1 ~> m s-1] @@ -868,7 +868,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS ! Determining the time-average sea surface height is part of the algorithm. ! This may be eta_av if Boussinesq, or need to be diagnosed if not. CS%time_in_cycle = CS%time_in_cycle + dt - call find_eta(h, CS%tv, G, GV, US, ssh, CS%eta_av_bc, eta_to_m=1.0, dZref=G%Z_ref) + call find_eta(h, CS%tv, G, GV, US, ssh, CS%eta_av_bc, dZref=G%Z_ref) do j=js,je ; do i=is,ie CS%ssh_rint(i,j) = CS%ssh_rint(i,j) + dt*ssh(i,j) enddo ; enddo @@ -2867,11 +2867,18 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif endif - if (.not.query_initialized(CS%ave_ssh_ibc,"ave_ssh",restart_CSp)) then + if (query_initialized(CS%ave_ssh_ibc,"ave_ssh",restart_CSp)) then + if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z /= US%m_to_Z_restart) ) then + Z_rescale = US%m_to_Z / US%m_to_Z_restart + do j=js,je ; do i=is,ie + CS%ave_ssh_ibc(i,j) = Z_rescale * CS%ave_ssh_ibc(i,j) + enddo ; enddo + endif + else if (CS%split) then - call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta, eta_to_m=1.0, dZref=G%Z_ref) + call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta, dZref=G%Z_ref) else - call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, eta_to_m=1.0, dZref=G%Z_ref) + call find_eta(CS%h, CS%tv, G, GV, US, CS%ave_ssh_ibc, dZref=G%Z_ref) endif endif if (CS%split) deallocate(eta) @@ -2977,7 +2984,7 @@ subroutine register_diags(Time, G, GV, US, IDs, diag) 'Layer Thickness after the dynamics update', thickness_units, conversion=GV%H_to_MKS, & v_extensive=.true.) IDs%id_ssh_inst = register_diag_field('ocean_model', 'SSH_inst', diag%axesT1, & - Time, 'Instantaneous Sea Surface Height', 'm') + Time, 'Instantaneous Sea Surface Height', 'm', conversion=US%Z_to_m) end subroutine register_diags !> Set up CPU clock IDs for timing various subroutines. @@ -3097,14 +3104,14 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: ssh !< time mean surface height [m] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: ssh !< time mean surface height [Z ~> m] real, dimension(:,:), pointer :: p_atm !< Ocean surface pressure [R L2 T-2 ~> Pa] logical, intent(in) :: use_EOS !< If true, calculate the density for !! the SSH correction using the equation of state. real :: Rho_conv(SZI_(G)) ! The density used to convert surface pressure to ! a corrected effective SSH [R ~> kg m-3]. - real :: IgR0 ! The SSH conversion factor from R L2 T-2 to m [m T2 R-1 L-2 ~> m Pa-1]. + real :: IgR0 ! The SSH conversion factor from R L2 T-2 to Z [Z T2 R-1 L-2 ~> m Pa-1]. logical :: calc_rho integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, is, ie, js, je @@ -3119,12 +3126,13 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) call calculate_density(tv%T(:,j,1), tv%S(:,j,1), 0.5*p_atm(:,j), Rho_conv, & tv%eqn_of_state, EOSdom) do i=is,ie - IgR0 = US%Z_to_m / (Rho_conv(i) * GV%g_Earth) + IgR0 = 1.0 / (Rho_conv(i) * GV%g_Earth) ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0 enddo else + IgR0 = 1.0 / (GV%Rho0 * GV%g_Earth) do i=is,ie - ssh(i,j) = ssh(i,j) + p_atm(i,j) * (US%Z_to_m / (GV%Rho0 * GV%g_Earth)) + ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0 enddo endif enddo @@ -3209,7 +3217,7 @@ subroutine extract_surface_state(CS, sfc_state_in) sfc_state%S_is_absS = CS%tv%S_is_absS do j=js,je ; do i=is,ie - sfc_state%sea_lev(i,j) = US%m_to_Z*CS%ave_ssh_ibc(i,j) + sfc_state%sea_lev(i,j) = CS%ave_ssh_ibc(i,j) enddo ; enddo if (allocated(sfc_state%frazil) .and. associated(CS%tv%frazil)) then ; do j=js,je ; do i=is,ie diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index e06cb235c4..8d667503d7 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -209,18 +209,23 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & ! tmp array for surface properties - real :: surface_field(SZI_(G),SZJ_(G)) + real :: surface_field(SZI_(G),SZJ_(G)) ! The surface temperature or salinity [degC] or [ppt] real :: pressure_1d(SZI_(G)) ! Temporary array for pressure when calling EOS [R L2 T-2 ~> Pa] - real :: wt, wt_p - + real :: wt, wt_p ! The fractional weights of two successive values when interpolating from + ! a list [nondim], scaled so that wt + wt_p = 1. real :: f2_h ! Squared Coriolis parameter at to h-points [T-2 ~> s-2] real :: mag_beta ! Magnitude of the gradient of f [T-1 L-1 ~> s-1 m-1] real :: absurdly_small_freq2 ! Frequency squared used to avoid division by 0 [T-2 ~> s-2] integer :: k_list - real, dimension(SZK_(GV)) :: temp_layer_ave, salt_layer_ave - real :: thetaoga, soga, masso, tosga, sosga + real, dimension(SZK_(GV)) :: temp_layer_ave ! The average temperature in a layer [degC] + real, dimension(SZK_(GV)) :: salt_layer_ave ! The average salinity in a layer [degC] + real :: thetaoga ! The volume mean potential temperature [degC] + real :: soga ! The volume mean ocean salinity [ppt] + real :: masso ! The total mass of the ocean [kg] + real :: tosga ! The area mean sea surface temperature [degC] + real :: sosga ! The area mean sea surface salinity [ppt] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -437,7 +442,7 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, & do j=js,je ; do i=is,ie surface_field(i,j) = tv%T(i,j,1) enddo ; enddo - tosga = global_area_mean(surface_field, G) + tosga = global_area_mean(tv%T(:,:,1), G) call post_data(CS%id_tosga, tosga, CS%diag) endif @@ -1240,7 +1245,8 @@ subroutine post_surface_dyn_diags(IDs, G, diag, sfc_state, ssh) type(diag_ctrl), intent(in) :: diag !< regulates diagnostic output type(surface), intent(in) :: sfc_state !< structure describing the ocean surface state real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: ssh !< Time mean surface height without corrections for ice displacement [m] + intent(in) :: ssh !< Time mean surface height without corrections + !! for ice displacement [Z ~> m] ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: speed ! The surface speed [L T-1 ~> m s-1] @@ -1280,23 +1286,25 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv real, intent(in) :: dt_int !< total time step associated with these diagnostics [T ~> s]. type(surface), intent(in) :: sfc_state !< structure describing the ocean surface state type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: ssh !< Time mean surface height without corrections for ice displacement [m] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh !< Time mean surface height without corrections + !! for ice displacement [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh_ibc !< Time mean surface height with corrections - !! for ice displacement and the inverse barometer [m] + !! for ice displacement and the inverse barometer [Z ~> m] real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! A 2-d work array real, dimension(SZI_(G),SZJ_(G)) :: & zos ! dynamic sea lev (zero area mean) from inverse-barometer adjusted ssh [m] real :: I_time_int ! The inverse of the time interval [T-1 ~> s-1]. - real :: zos_area_mean, volo, ssh_ga + real :: zos_area_mean ! Global area mean sea surface height [m] + real :: volo ! Total volume of the ocean [m3] + real :: ssh_ga ! Global ocean area weighted mean sea seaface height [m] integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ! area mean SSH if (IDs%id_ssh_ga > 0) then - ssh_ga = global_area_mean(ssh, G) + ssh_ga = global_area_mean(ssh, G, scale=US%Z_to_m) call post_data(IDs%id_ssh_ga, ssh_ga, diag) endif @@ -1306,7 +1314,7 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv if (IDs%id_zos > 0 .or. IDs%id_zossq > 0) then zos(:,:) = 0.0 do j=js,je ; do i=is,ie - zos(i,j) = ssh_ibc(i,j) + zos(i,j) = US%Z_to_m*ssh_ibc(i,j) enddo ; enddo zos_area_mean = global_area_mean(zos, G) do j=js,je ; do i=is,ie @@ -1324,9 +1332,9 @@ subroutine post_surface_thermo_diags(IDs, G, GV, US, diag, dt_int, sfc_state, tv ! post total volume of the liquid ocean if (IDs%id_volo > 0) then do j=js,je ; do i=is,ie - work_2d(i,j) = G%mask2dT(i,j)*(ssh(i,j) + US%Z_to_m*G%bathyT(i,j)) + work_2d(i,j) = G%mask2dT(i,j) * (ssh(i,j) + G%bathyT(i,j)) enddo ; enddo - volo = global_area_integral(work_2d, G) + volo = global_area_integral(work_2d, G, scale=US%Z_to_m) call post_data(IDs%id_volo, volo, diag) endif @@ -1841,7 +1849,7 @@ subroutine register_surface_diags(Time, G, US, IDs, diag, tv) standard_name='square_of_sea_surface_height_above_geoid', & long_name='Square of sea surface height above geoid', units='m2') IDs%id_ssh = register_diag_field('ocean_model', 'SSH', diag%axesT1, Time, & - 'Sea Surface Height', 'm') + 'Sea Surface Height', 'm', conversion=US%Z_to_m) IDs%id_ssh_ga = register_scalar_field('ocean_model', 'ssh_ga', Time, diag,& long_name='Area averaged sea surface height', units='m', & standard_name='area_averaged_sea_surface_height') From 86eb106ac0be403986ffbb64376fb8f7319f84f6 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 15 Dec 2021 05:32:23 -0500 Subject: [PATCH 25/73] Correct the units in two comments Corrected the reported unit conversions in two comments describing variables in MOM_offline_aux.F90. All answers and output are bitwise identical. --- src/tracer/MOM_offline_aux.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index f95f2cd40e..b5d9c38fac 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -144,8 +144,8 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) ! top [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: bottom_flux ! Net downward fluxes through the layer ! bottom [H ~> m or kg m-2] - real :: pos_flux ! Net flux out of cell [H L2 ~> m3 or kg m-2] - real :: hvol ! Cell volume [H L2 ~> m3 or kg m-2] + real :: pos_flux ! Net flux out of cell [H L2 ~> m3 or kg] + real :: hvol ! Cell volume [H L2 ~> m3 or kg] real :: scale_factor ! A nondimensional rescaling factor between 0 and 1 [nondim] real :: max_off_cfl ! The maximum permitted fraction that can leave in a timestep [nondim] integer :: i, j, k, m, is, ie, js, je, nz From 049241ce1622355fe7f1639294fc06deafd061b1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 16 Dec 2021 05:22:10 -0500 Subject: [PATCH 26/73] +Rescaled optics%opacity_band Rescaled the units of optics%opacity_band from [m-1] to [Z-1 ~> m-1], with the opacity values returned from extract_optics_slice also rescaled by the same factor, which can be offset by compensating changes to the opacity_scale argument. Also rescaled 4 other internal variables and documented the units on 3 more. One uncommon parameter (SW_1ST_EXP_RATIO) listed the wrong units in its get_param call, and this was corrected, but turned out not to have been logged for any of the MOM6-examples test cases. Some compensating changes were also made in the MOM_generic_tracer module, which directly accesses the contents of the optics_type (thereby preventing it from being opaque). All answers and output in the MOM6-examples test suite are bitwise identical. --- .../vertical/MOM_bulk_mixed_layer.F90 | 2 +- .../vertical/MOM_diabatic_aux.F90 | 4 +- .../vertical/MOM_opacity.F90 | 56 +++++++++---------- src/tracer/MOM_generic_tracer.F90 | 23 ++++---- 4 files changed, 42 insertions(+), 43 deletions(-) diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 046329523d..926eaaa013 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -424,7 +424,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C eps(i,k) = 0.0 ; if (k > nkmb) eps(i,k) = GV%Angstrom_H T(i,k) = tv%T(i,j,k) ; S(i,k) = tv%S(i,j,k) enddo ; enddo - if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacity_band, opacity_scale=GV%H_to_m) + if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacity_band, opacity_scale=GV%H_to_Z) do k=1,nz ; do i=is,ie d_ea(i,k) = 0.0 ; d_eb(i,k) = 0.0 diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 312d114dde..b0ca5a931e 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1105,7 +1105,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! To accommodate vanishing upper layers, we need to allow for an instantaneous ! distribution of forcing over some finite vertical extent. The bulk mixed layer ! code handles this issue properly. - H_limit_fluxes = max(GV%Angstrom_H, 1.E-30*GV%m_to_H) + H_limit_fluxes = max(GV%Angstrom_H, 1.0e-30*GV%m_to_H) ! diagnostic to see if need to create mass to avoid grounding if (CS%id_createdH>0) CS%createdH(:,:) = 0. @@ -1160,7 +1160,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! Nothing more is done on this j-slice if there is no buoyancy forcing. if (.not.associated(fluxes%sw)) cycle - if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacityBand, opacity_scale=(1.0/GV%m_to_H)) + if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacityBand, opacity_scale=(1.0/GV%Z_to_H)) ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index a99524060b..658170beda 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -25,7 +25,7 @@ module MOM_opacity type, public :: optics_type integer :: nbands !< The number of penetrating bands of SW radiation - real, allocatable :: opacity_band(:,:,:,:) !< SW optical depth per unit thickness [m-1] + real, allocatable :: opacity_band(:,:,:,:) !< SW optical depth per unit thickness [Z-1 ~> m-1] !! The number of radiation bands is most rapidly varying (first) index. real, allocatable :: sw_pen_band(:,:,:) !< shortwave radiation [Q R Z T-1 ~> W m-2] @@ -55,15 +55,15 @@ module MOM_opacity !! water properties into the opacity (i.e., the e-folding depth) and !! (perhaps) the number of bands of penetrating shortwave radiation to use. real :: pen_sw_scale !< The vertical absorption e-folding depth of the - !! penetrating shortwave radiation [m]. + !! penetrating shortwave radiation [Z ~> m]. real :: pen_sw_scale_2nd !< The vertical absorption e-folding depth of the - !! (2nd) penetrating shortwave radiation [m]. - real :: SW_1ST_EXP_RATIO !< Ratio for 1st exp decay in Two Exp decay opacity + !! (2nd) penetrating shortwave radiation [Z ~> m]. + real :: SW_1ST_EXP_RATIO !< Ratio for 1st exp decay in Two Exp decay opacity [nondim] real :: pen_sw_frac !< The fraction of shortwave radiation that is - !! penetrating with a constant e-folding approach. + !! penetrating with a constant e-folding approach [nondim] real :: blue_frac !< The fraction of the penetrating shortwave !! radiation that is in the blue band [nondim]. - real :: opacity_land_value !< The value to use for opacity over land [m-1]. + real :: opacity_land_value !< The value to use for opacity over land [Z-1 ~> m-1]. !! The default is 10 m-1 - a value for muddy water. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. @@ -107,15 +107,15 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ ! Local variables integer :: i, j, k, n, is, ie, js, je, nz - real :: inv_sw_pen_scale ! The inverse of the e-folding scale [m-1]. + real :: inv_sw_pen_scale ! The inverse of the e-folding scale [Z-1 ~> m-1]. real :: Inv_nbands ! The inverse of the number of bands of penetrating ! shortwave radiation [nondim] logical :: call_for_surface ! if horizontal slice is the surface layer - real :: tmp(SZI_(G),SZJ_(G),SZK_(GV)) ! A 3-d temporary array. + real :: tmp(SZI_(G),SZJ_(G),SZK_(GV)) ! A 3-d temporary array for diagnosing opacity [Z-1 ~> m-1] real :: chl(SZI_(G),SZJ_(G),SZK_(GV)) ! The concentration of chlorophyll-A [mg m-3]. real :: Pen_SW_tot(SZI_(G),SZJ_(G)) ! The penetrating shortwave radiation ! summed across all bands [Q R Z T-1 ~> W m-2]. - real :: op_diag_len ! A tiny lengthscale [m] used to remap opacity + real :: op_diag_len ! A tiny lengthscale [Z ~> m] used to remap diagnostics of opacity ! from op to 1/op_diag_len * tanh(op * op_diag_len) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -128,14 +128,14 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ else ; Inv_nbands = 1.0 / real(optics%nbands) ; endif ! Make sure there is no division by 0. - inv_sw_pen_scale = 1.0 / max(CS%pen_sw_scale, 0.1*GV%Angstrom_m, & - GV%H_to_m*GV%H_subroundoff) + inv_sw_pen_scale = 1.0 / max(CS%pen_sw_scale, 0.1*GV%Angstrom_Z, & + GV%H_to_Z*GV%H_subroundoff) if ( CS%Opacity_scheme == DOUBLE_EXP ) then !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie optics%opacity_band(1,i,j,k) = inv_sw_pen_scale optics%opacity_band(2,i,j,k) = 1.0 / max(CS%pen_sw_scale_2nd, & - 0.1*GV%Angstrom_m,GV%H_to_m*GV%H_subroundoff) + 0.1*GV%Angstrom_Z, GV%H_to_Z*GV%H_subroundoff) enddo ; enddo ; enddo if (.not.associated(sw_total) .or. (CS%pen_SW_scale <= 0.0)) then !$OMP parallel do default(shared) @@ -199,7 +199,7 @@ subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_ call post_data(CS%id_sw_vis_pen, Pen_SW_tot, CS%diag) endif do n=1,optics%nbands ; if (CS%id_opacity(n) > 0) then - op_diag_len = 1e-10 ! A dimensional depth to constrain the range of opacity [m] + op_diag_len = 1.0e-10*US%m_to_Z ! A minimal extinction depth to constrain the range of opacity [Z ~> m] !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do i=is,ie ! Remap opacity (op) to 1/L * tanh(op * L) where L is one Angstrom. @@ -375,18 +375,18 @@ subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir enddo else ! Band 1 is Manizza blue. - optics%opacity_band(1,i,j,k) = 0.0232 + 0.074*chl_data(i,j)**0.674 + optics%opacity_band(1,i,j,k) = (0.0232 + 0.074*chl_data(i,j)**0.674) * US%Z_to_m if (nbands >= 2) & ! Band 2 is Manizza red. - optics%opacity_band(2,i,j,k) = 0.225 + 0.037*chl_data(i,j)**0.629 + optics%opacity_band(2,i,j,k) = (0.225 + 0.037*chl_data(i,j)**0.629) * US%Z_to_m ! All remaining bands are NIR, for lack of something better to do. - do n=3,nbands ; optics%opacity_band(n,i,j,k) = 2.86 ; enddo + do n=3,nbands ; optics%opacity_band(n,i,j,k) = 2.86*US%Z_to_m ; enddo endif enddo ; enddo case (MOREL_88) do j=js,je ; do i=is,ie optics%opacity_band(1,i,j,k) = CS%opacity_land_value if (G%mask2dT(i,j) > 0.5) & - optics%opacity_band(1,i,j,k) = opacity_morel(chl_data(i,j)) + optics%opacity_band(1,i,j,k) = US%Z_to_m * opacity_morel(chl_data(i,j)) do n=2,optics%nbands optics%opacity_band(n,i,j,k) = optics%opacity_band(1,i,j,k) @@ -460,7 +460,8 @@ subroutine extract_optics_slice(optics, j, G, GV, opacity, opacity_scale, penSW_ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(max(optics%nbands,1),SZI_(G),SZK_(GV)), & - optional, intent(out) :: opacity !< The opacity in each band, i-point, and layer + optional, intent(out) :: opacity !< The opacity in each band, i-point, and layer [Z-1 ~> m-1], + !! but with units that can be altered by opacity_scale. real, optional, intent(in) :: opacity_scale !< A factor by which to rescale the opacity. real, dimension(max(optics%nbands,1),SZI_(G)), & optional, intent(out) :: penSW_top !< The shortwave radiation [Q R Z T-1 ~> W m-2] @@ -866,7 +867,7 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & if (h(i,k) > 0.0) then do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then ! SW_trans is the SW that is transmitted THROUGH the layer - opt_depth = h(i,k)*GV%H_to_m * optics%opacity_band(n,i,j,k) + opt_depth = h(i,k)*GV%H_to_Z * optics%opacity_band(n,i,j,k) exp_OD = exp(-opt_depth) SW_trans = exp_OD @@ -1015,19 +1016,18 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) call MOM_mesg('opacity_init: opacity scheme set to "'//trim(tmpstr)//'".', 5) endif call get_param(param_file, mdl, "PEN_SW_SCALE", CS%pen_sw_scale, & - "The vertical absorption e-folding depth of the "//& - "penetrating shortwave radiation.", units="m", default=0.0) + "The vertical absorption e-folding depth of the penetrating shortwave radiation.", & + units="m", default=0.0, scale=US%m_to_Z) !BGR/ Added for opacity_scheme==double_exp read in 2nd exp-decay and fraction if (CS%Opacity_scheme == DOUBLE_EXP ) then call get_param(param_file, mdl, "PEN_SW_SCALE_2ND", CS%pen_sw_scale_2nd, & "The (2nd) vertical absorption e-folding depth of the "//& - "penetrating shortwave radiation "//& - "(use if SW_EXP_MODE==double.)",& - units="m", default=0.0) + "penetrating shortwave radiation (use if SW_EXP_MODE==double.)", & + units="m", default=0.0, scale=US%m_to_Z) call get_param(param_file, mdl, "SW_1ST_EXP_RATIO", CS%sw_1st_exp_ratio, & "The fraction of 1st vertical absorption e-folding depth "//& "penetrating shortwave radiation if SW_EXP_MODE==double.",& - units="m", default=0.0) + units="nondim", default=0.0) elseif (CS%OPACITY_SCHEME == Single_Exp) then !/Else disable 2nd_exp scheme CS%pen_sw_scale_2nd = 0.0 @@ -1094,12 +1094,12 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) call get_param(param_file, mdl, "OPACITY_LAND_VALUE", CS%opacity_land_value, & "The value to use for opacity over land. The default is "//& - "10 m-1 - a value for muddy water.", units="m-1", default=10.0) + "10 m-1 - a value for muddy water.", units="m-1", default=10.0, scale=US%Z_to_m) CS%warning_issued = .false. if (.not.allocated(optics%opacity_band)) & - allocate(optics%opacity_band(optics%nbands,isd:ied,jsd:jed,nz)) + allocate(optics%opacity_band(optics%nbands,isd:ied,jsd:jed,nz), source=0.0) if (.not.allocated(optics%sw_pen_band)) & allocate(optics%sw_pen_band(optics%nbands,isd:ied,jsd:jed)) allocate(CS%id_opacity(optics%nbands), source=-1) @@ -1114,7 +1114,7 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) longname = 'Opacity for shortwave radiation in band '//trim(adjustl(bandnum)) & // ', saved as L^-1 tanh(Opacity * L) for L = 10^-10 m' CS%id_opacity(n) = register_diag_field('ocean_model', shortname, diag%axesTL, Time, & - longname, 'm-1') + longname, 'm-1', conversion=US%m_to_Z) enddo end subroutine opacity_init diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 4627d0ec80..fbde0dc04e 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -54,7 +54,7 @@ module MOM_generic_tracer implicit none ; private - !> An state hidden in module data that is very much not allowed in MOM6 + !> A state hidden in module data that is very much not allowed in MOM6 ! ### This needs to be fixed logical :: g_registered = .false. @@ -83,13 +83,8 @@ module MOM_generic_tracer !> Pointer to the first element of the linked list of generic tracers. type(g_tracer_type), pointer :: g_tracer_list => NULL() - integer :: H_to_m !< Auxiliary to access GV%H_to_m in routines that do not have access to GV - end type MOM_generic_tracer_CS -! This include declares and sets the variable "version". -#include "version_variable.h" - contains !> Initializes the generic tracer packages and adds their tracers to the list @@ -104,9 +99,12 @@ function register_MOM_generic_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) !! advection and diffusion module. type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct -! Local variables + ! Local variables logical :: register_MOM_generic_tracer + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=128), parameter :: sub_name = 'register_MOM_generic_tracer' character(len=200) :: inputdir ! The directory where NetCDF input files are. ! These can be overridden later in via the field manager? @@ -381,8 +379,6 @@ subroutine initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, call g_tracer_set_csdiag(CS%diag) #endif - CS%H_to_m = GV%H_to_m - end subroutine initialize_MOM_generic_tracer !> Column physics for generic tracers. @@ -503,7 +499,8 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! !Calculate tendencies (i.e., field changes at dt) from the sources / sinks ! - if ((G%US%L_to_m == 1.0) .and. (G%US%RZ_to_kg_m2 == 1.0) .and. (G%US%s_to_T == 1.0)) then + if ((G%US%L_to_m == 1.0) .and. (G%US%s_to_T == 1.0) .and. (G%US%Z_to_m == 1.0) .and. & + (G%US%Q_to_J_kg == 1.0) .and. (G%US%RZ_to_kg_m2 == 1.0)) then ! Avoid unnecessary copies when no unit conversion is needed. call generic_tracer_source(tv%T, tv%S, rho_dzt, dzt, dz_ml, G%isd, G%jsd, 1, dt, & G%areaT, get_diag_time_end(CS%diag), & @@ -512,7 +509,9 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, else call generic_tracer_source(tv%T, tv%S, rho_dzt, dzt, dz_ml, G%isd, G%jsd, 1, dt, & G%US%L_to_m**2*G%areaT(:,:), get_diag_time_end(CS%diag), & - optics%nbands, optics%max_wavelength_band, optics%sw_pen_band, optics%opacity_band, & + optics%nbands, optics%max_wavelength_band, & + sw_pen_band=G%US%QRZ_T_to_W_m2*optics%sw_pen_band(:,:,:), & + opacity_band=G%US%m_to_Z*optics%opacity_band(:,:,:,:), & internal_heat=G%US%RZ_to_kg_m2*tv%internal_heat(:,:), & frunoff=G%US%RZ_T_to_kg_m2s*fluxes%frunoff(:,:), sosga=sosga) endif @@ -864,7 +863,7 @@ subroutine MOM_generic_tracer_surface_state(sfc_state, h, G, GV, CS) !nnz: fake rho0 rho0=1.0 - dzt(:,:,:) = CS%H_to_m * h(:,:,:) + dzt(:,:,:) = GV%H_to_m * h(:,:,:) sosga = global_area_mean(sfc_state%SSS, G) From 0544f9f2e31eec2e14f98720700a993907cf5ab8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 16 Dec 2021 06:50:29 -0500 Subject: [PATCH 27/73] +(*)Avoid segmentation faults if PEN_SW_NBANDS = 0 Modified three routines in MOM_opacity to avoid segmentation faults if PEN_SW_NBANDS = 0, and hence if the optics type is not being allocated. In the case of optics_nbands(), this involved formally changing an optics_type argument into a pointer to an optics_type. (Pointers to an optics_type were already been used as the argument in all calls to optics_nbands(), but it was not always associated.) In two other routines, the change is simply to add a return call if there are 0 bands of shortwave radiation. With these changes, the single column test cases with no penetrating shortwave radiation now successfully run if PEN_SW_NBANDS = 0 and give answers that are identical to those obtained with PEN_SW_NBANDS = 1. All answers and output in cases that ran previously are bitwise identical, but there is a subtle change in a public interface. --- .../vertical/MOM_opacity.F90 | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 658170beda..9aa8fafd14 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -503,11 +503,15 @@ end subroutine extract_optics_fields !> Return the number of bands of penetrating shortwave radiation. function optics_nbands(optics) - type(optics_type), intent(in) :: optics !< An optics structure that has values of opacities + type(optics_type), pointer :: optics !< An optics structure that has values of opacities !! and shortwave fluxes. integer :: optics_nbands !< The number of penetrating bands of SW radiation - optics_nbands = optics%nbands + if (associated(optics)) then + optics_nbands = optics%nbands + else + optics_nbands = 0 + endif end function optics_nbands !> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inherited @@ -617,8 +621,10 @@ subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_l ! TKE budget of the shortwave heating. real :: C1_6, C1_60 integer :: is, ie, nz, i, k, ks, n - SW_Remains = .false. + if (nsw < 1) return + + SW_Remains = .false. min_SW_heat = optics%PenSW_flux_absorb * dt I_Habs = optics%PenSW_absorb_Invlen @@ -842,12 +848,16 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & integer :: is, ie, nz, i, k, ks, n SW_Remains = .false. - min_SW_heat = optics%PenSW_flux_absorb*dt ! Default of 2.5e-11*US%T_to_s*GV%m_to_H I_Habs = 1e3*GV%H_to_m ! optics%PenSW_absorb_Invlen h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = GV%ke + if (nsw < 1) then + netPen(:,:) = 0.0 + return + endif + pen_SW_bnd(:,:) = iPen_SW_bnd(:,:) do i=is,ie ; h_heat(i) = 0.0 ; enddo do i=is,ie @@ -859,6 +869,7 @@ subroutine sumSWoverBands(G, GV, US, h, nsw, optics, j, dt, & ! Apply penetrating SW radiation to remaining parts of layers. ! Excessively thin layers are not heated to avoid runaway temps. + min_SW_heat = optics%PenSW_flux_absorb*dt ! Default of 2.5e-11*US%T_to_s*GV%m_to_H do k=1,nz do i=is,ie From 50df270e87c40ad861c8d65cde6de9b53de6cf2f Mon Sep 17 00:00:00 2001 From: OlgaSergienko <39838355+OlgaSergienko@users.noreply.github.com> Date: Fri, 17 Dec 2021 17:33:09 -0500 Subject: [PATCH 28/73] Ice dynamics (#35) * In MOM_ice_shelf_dynamics.F90 changes are made to calc_shelf_visc() and calc_shelf_driving_stress() to account for an irregular quadrilateral grid. In MOM_ice_shelf_initialize.F90 changes are made to initialize_ice_thickness_from_file() to correct masks at initialization. * Changed indentation * Changes are made to 'calc_shelf_visc()` to make computations of the velocity derivatives rotation-invariant. Changes in `update_ice_shelf()` utilize G%IareaT(:,:) instead of 1/G%areaT(:,:). --- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 118 ++++++++++++++------- src/ice_shelf/MOM_ice_shelf_initialize.F90 | 45 ++++---- 2 files changed, 99 insertions(+), 64 deletions(-) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index df2e801613..8fb674e36c 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -260,9 +260,9 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) allocate( CS%v_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) allocate( CS%t_shelf(isd:ied,jsd:jed), source=-10.0 ) ! [degC] allocate( CS%ice_visc(isd:ied,jsd:jed), source=0.0 ) - allocate( CS%AGlen_visc(isd:ied,jsd:jed), source=2.261e-25 ) ! [Units?] + allocate( CS%AGlen_visc(isd:ied,jsd:jed), source=2.261e-25 ) ! [Pa-3s-1] allocate( CS%basal_traction(isd:ied,jsd:jed), source=0.0 ) - allocate( CS%C_basal_friction(isd:ied,jsd:jed), source=5.0e10 ) ! [Units?] + allocate( CS%C_basal_friction(isd:ied,jsd:jed), source=5.0e10 ) ! [Pa (m-1 s)^n_sliding] allocate( CS%OD_av(isd:ied,jsd:jed), source=0.0 ) allocate( CS%ground_frac(isd:ied,jsd:jed), source=0.0 ) allocate( CS%taudx_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) @@ -553,8 +553,8 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call pass_vector(CS%u_bdry_val, CS%v_bdry_val, G%domain, TO_ALL, BGRID_NE) call pass_vector(CS%u_face_mask_bdry, CS%v_face_mask_bdry, G%domain, TO_ALL, BGRID_NE) - !initialize ice flow velocities from file - call initialize_ice_flow_from_file(CS%bed_elev,CS%u_shelf, CS%v_shelf,CS%ground_frac, ISS%hmask,ISS%h_shelf, & + !initialize ice flow characteristic (velocities, bed elevation under the grounded part, etc) from file + call initialize_ice_flow_from_file(CS%bed_elev,CS%u_shelf, CS%v_shelf,CS%ground_frac, & G, US, param_file) call pass_vector(CS%u_shelf, CS%v_shelf, G%domain, TO_ALL, BGRID_NE) call pass_var(CS%bed_elev, G%domain,CENTER) @@ -567,9 +567,9 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ 'y-velocity of ice', 'm yr-1', conversion=365.0*86400.0*US%L_T_to_m_s) ! I think that the conversion factors for the next two diagnostics are wrong. - RWH CS%id_taudx_shelf = register_diag_field('ice_shelf_model','taudx_shelf',CS%diag%axesB1, Time, & - 'x-driving stress of ice', 'kPa', conversion=1.e-9*US%RL2_T2_to_Pa) + 'x-driving stress of ice', 'kPa', conversion=1.e-3*US%RL2_T2_to_Pa) CS%id_taudy_shelf = register_diag_field('ice_shelf_model','taudy_shelf',CS%diag%axesB1, Time, & - 'y-driving stress of ice', 'kPa', conversion=1.e-9*US%RL2_T2_to_Pa) + 'y-driving stress of ice', 'kPa', conversion=1.e-3*US%RL2_T2_to_Pa) CS%id_u_mask = register_diag_field('ice_shelf_model','u_mask',CS%diag%axesB1, Time, & 'mask for u-nodes', 'none') CS%id_v_mask = register_diag_field('ice_shelf_model','v_mask',CS%diag%axesB1, Time, & @@ -579,9 +579,9 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ CS%id_col_thick = register_diag_field('ice_shelf_model','col_thick',CS%diag%axesT1, Time, & 'ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) CS%id_visc_shelf = register_diag_field('ice_shelf_model','ice_visc',CS%diag%axesT1, Time, & - 'viscosity', 'm', conversion=1e-6*US%Z_to_m) + 'vi-viscosity', 'Pa s-1 m', conversion=US%RL2_T2_to_Pa*US%L_T_to_m_s) !vertically integrated viscosity CS%id_taub = register_diag_field('ice_shelf_model','taub_beta',CS%diag%axesT1, Time, & - 'taub', 'Pa yr m-1', conversion=1e-6*US%Z_to_m) + 'taub', 'MPa', conversion=1e-6*US%RL2_T2_to_Pa) CS%id_OD_av = register_diag_field('ice_shelf_model','OD_av',CS%diag%axesT1, Time, & 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) endif @@ -673,7 +673,10 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled logical, optional, intent(in) :: coupled_grounding !< If true, the grounding line is !! determined by coupled ice-ocean dynamics logical, optional, intent(in) :: must_update_vel !< Always update the ice velocities if true. - + real, dimension(SZDIB_(G),SZDJB_(G)) ::taud_x,taud_y ! Pa] + real, dimension(SZDI_(G),SZDJ_(G)) :: ice_visc ! Pa s-1 m] + real, dimension(SZDI_(G),SZDJ_(G)) :: basal_tr ! Pa] integer :: iters logical :: update_ice_vel, coupled_GL @@ -706,12 +709,24 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf, CS%diag) ! if (CS%id_t_shelf > 0) call post_data(CS%id_t_shelf,CS%t_shelf,CS%diag) - if (CS%id_taudx_shelf > 0) call post_data(CS%id_taudx_shelf, CS%taudx_shelf, CS%diag) - if (CS%id_taudy_shelf > 0) call post_data(CS%id_taudy_shelf, CS%taudy_shelf, CS%diag) + if (CS%id_taudx_shelf > 0) then + taud_x(:,:) = CS%taudx_shelf(:,:)*G%IareaT(:,:) + call post_data(CS%id_taudx_shelf,taud_x , CS%diag) + endif + if (CS%id_taudy_shelf > 0) then + taud_y(:,:) = CS%taudy_shelf(:,:)*G%IareaT(:,:) + call post_data(CS%id_taudy_shelf,taud_y , CS%diag) + endif if (CS%id_ground_frac > 0) call post_data(CS%id_ground_frac, CS%ground_frac,CS%diag) if (CS%id_OD_av >0) call post_data(CS%id_OD_av, CS%OD_av,CS%diag) - if (CS%id_visc_shelf > 0) call post_data(CS%id_visc_shelf, CS%ice_visc,CS%diag) - if (CS%id_taub > 0) call post_data(CS%id_taub, CS%basal_traction,CS%diag) + if (CS%id_visc_shelf > 0) then + ice_visc(:,:)=CS%ice_visc(:,:)*G%IareaT(:,:) + call post_data(CS%id_visc_shelf, ice_visc,CS%diag) + endif + if (CS%id_taub > 0) then + basal_tr(:,:) = CS%basal_traction(:,:)*G%IareaT(:,:) + call post_data(CS%id_taub, basal_tr,CS%diag) + endif !! if (CS%id_u_mask > 0) call post_data(CS%id_u_mask,CS%umask,CS%diag) if (CS%id_v_mask > 0) call post_data(CS%id_v_mask,CS%vmask,CS%diag) @@ -874,6 +889,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, i if (rhoi_rhow * ISS%h_shelf(i,j) - CS%bed_elev(i,j) > 0) then float_cond(i,j) = 1.0 CS%ground_frac(i,j) = 1.0 + CS%OD_av(i,j) =0.0 endif enddo enddo @@ -960,7 +976,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, i !! begin loop - do iter=1,100 + do iter=1,50 call ice_shelf_solve_inner(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, H_node, float_cond, & ISS%hmask, conv_flag, iters, time, Phi, Phisub) @@ -1775,7 +1791,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) intent(inout) :: taudx !< X-direction driving stress at q-points [kg L s-2 ~> kg m s-2] real, dimension(SZDIB_(G),SZDJB_(G)), & intent(inout) :: taudy !< Y-direction driving stress at q-points [kg L s-2 ~> kg m s-2] - ! This will become [R L3 Z T-2 ~> kg m s-2] + ! This will become [R L3 Z T-2 ~> kg m s-2] ! driving stress! @@ -1790,12 +1806,14 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) real, dimension(SIZE(OD,1),SIZE(OD,2)) :: S, & ! surface elevation [Z ~> m]. BASE ! basal elevation of shelf/stream [Z ~> m]. + real, pointer, dimension(:,:,:,:) :: Phi => NULL() ! The gradients of bilinear basis elements at Gaussian + ! quadrature points surrounding the cell vertices [m-1]. real :: rho, rhow, rhoi_rhow ! Ice and ocean densities [R ~> kg m-3] real :: sx, sy ! Ice shelf top slopes [Z L-1 ~> nondim] real :: neumann_val ! [R Z L2 T-2 ~> kg s-2] - real :: dxh, dyh ! Local grid spacing [L ~> m] + real :: dxh, dyh,Dx,Dy ! Local grid spacing [L ~> m] real :: grav ! The gravitational acceleration [L2 Z-1 T-2 ~> m s-2] integer :: i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq @@ -1813,6 +1831,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) is = iscq - 1; js = jscq - 1 i_off = G%idg_offset ; j_off = G%jdg_offset + rho = CS%density_ice rhow = CS%density_ocean_avg grav = CS%g_Earth @@ -1821,13 +1840,14 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) ! or is this faster? BASE(:,:) = -CS%bed_elev(:,:) + OD(:,:) - S(:,:) = BASE(:,:) + ISS%h_shelf(:,:) - + S(:,:) = -CS%bed_elev(:,:) + ISS%h_shelf(:,:) ! check whether the ice is floating or grounded do j=jsc-G%domain%njhalo,jec+G%domain%njhalo do i=isc-G%domain%nihalo,iec+G%domain%nihalo if (rhoi_rhow * ISS%h_shelf(i,j) - CS%bed_elev(i,j) <= 0) then S(i,j) = (1 - rhoi_rhow)*ISS%h_shelf(i,j) + else + S(i,j)=ISS%h_shelf(i,j)-CS%bed_elev(i,j) endif enddo enddo @@ -1838,7 +1858,8 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) sy = 0 dxh = G%dxT(i,j) dyh = G%dyT(i,j) - + Dx=dxh + Dy=dyh if (ISS%hmask(i,j) == 1) then ! we are inside the global computational bdry, at an ice-filled cell ! calculate sx @@ -1857,12 +1878,14 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) else ! interior if (ISS%hmask(i+1,j) == 1) then cnt = cnt+1 + Dx =dxh+ G%dxT(i+1,j) sx = S(i+1,j) else sx = S(i,j) endif if (ISS%hmask(i-1,j) == 1) then cnt = cnt+1 + Dx =dxh+ G%dxT(i-1,j) sx = sx - S(i-1,j) else sx = sx - S(i,j) @@ -1870,7 +1893,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) if (cnt == 0) then sx = 0 else - sx = sx / (cnt * dxh) + sx = sx / ( Dx) endif endif @@ -1892,6 +1915,7 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) else ! interior if (ISS%hmask(i,j+1) == 1) then cnt = cnt+1 + Dy =dyh+ G%dyT(i,j+1) sy = S(i,j+1) else sy = S(i,j) @@ -1899,13 +1923,14 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) if (ISS%hmask(i,j-1) == 1) then cnt = cnt+1 sy = sy - S(i,j-1) + Dy =dyh+ G%dyT(i,j-1) else sy = sy - S(i,j) endif if (cnt == 0) then sy = 0 else - sy = sy / (cnt * dyh) + sy = sy / (Dy) endif endif @@ -1930,10 +1955,10 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) taudy(I,J) = taudy(I,J) - .25 * rho * grav * ISS%h_shelf(i,j) * sy * G%areaT(i,j) endif if (CS%ground_frac(i,j) == 1) then -! neumann_val = .5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * CS%bed_elev(i,j)**2) +! neumann_val = (.5 * grav * (rho * ISS%h_shelf(i,j)**2 - rhow * CS%bed_elev(i,j)**2)) neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 else - neumann_val = .5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2 + neumann_val = (.5 * grav * (1-rho/rhow) * rho * ISS%h_shelf(i,j)**2) endif if ((CS%u_face_mask(I-1,j) == 2) .OR. (ISS%hmask(i-1,j) == 0) .OR. (ISS%hmask(i-1,j) == 2) ) then @@ -1971,7 +1996,6 @@ subroutine calc_shelf_driving_stress(CS, ISS, G, US, taudx, taudy, OD) endif enddo enddo - end subroutine calc_shelf_driving_stress subroutine init_boundary_values(CS, G, time, hmask, input_flux, input_thick, new_sim) @@ -2528,8 +2552,8 @@ subroutine apply_boundary_values(CS, ISS, G, US, time, Phisub, H_node, ice_visc, call pass_vector(u_bdry_contr, v_bdry_contr, G%domain, TO_ALL, BGRID_NE) end subroutine apply_boundary_values + !> Update depth integrated viscosity, based on horizontal strain rates, and also update the -!! nonlinear part of the basal traction. subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) type(ice_shelf_dyn_CS), intent(inout) :: CS !< A pointer to the ice shelf control structure type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe @@ -2540,9 +2564,9 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) intent(inout) :: u_shlf !< The zonal ice shelf velocity [L T-1 ~> m s-1]. real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB), & intent(inout) :: v_shlf !< The meridional ice shelf velocity [L T-1 ~> m s-1]. - + real, pointer, dimension(:,:,:,:) :: Phi => NULL() ! The gradients of bilinear basis elements at Gaussian + ! quadrature points surrounding the cell vertices [m-1]. ! update DEPTH_INTEGRATED viscosity, based on horizontal strain rates - this is for bilinear FEM solve -! so there is an "upper" and "lower" bilinear viscosity ! also this subroutine updates the nonlinear part of the basal traction @@ -2553,7 +2577,7 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) real :: Visc_coef, n_g real :: ux, uy, vx, vy real :: eps_min, dxh, dyh ! Velocity shears [T-1 ~> s-1] - real, dimension(8,4) :: Phi +! real, dimension(8,4) :: Phi real, dimension(2) :: xquad ! real :: umid, vmid, unorm ! Velocities [L T-1 ~> m s-1] @@ -2566,6 +2590,12 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) is = iscq - 1; js = jscq - 1 i_off = G%idg_offset ; j_off = G%jdg_offset + allocate(Phi(1:8,1:4,isd:ied,jsd:jed), source=0.0) + + do j=jsc,jec ; do i=isc,iec + call bilinear_shape_fn_grid(G, i, j, Phi(:,:,i,j)) + enddo ; enddo + n_g = CS%n_glen; eps_min = CS%eps_glen_min CS%ice_visc(:,:)=1e22 ! Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%A_glen_isothermal)**(-1./CS%n_glen) @@ -2575,21 +2605,35 @@ subroutine calc_shelf_visc(CS, ISS, G, US, u_shlf, v_shlf) if ((ISS%hmask(i,j) == 1) .OR. (ISS%hmask(i,j) == 3)) then Visc_coef = US%kg_m2s_to_RZ_T*US%m_to_L*US%Z_to_L*(CS%AGlen_visc(i,j))**(-1./CS%n_glen) - ux = ((u_shlf(I,J) + (u_shlf(I,J-1) + u_shlf(I,J+1))) - & - (u_shlf(I-1,J) + (u_shlf(I-1,J-1) + u_shlf(I-1,J+1)))) / (3*G%dxT(i,j)) - vx = ((v_shlf(I,J) + v_shlf(I,J-1) + v_shlf(I,J+1)) - & - (v_shlf(I-1,J) + (v_shlf(I-1,J-1) + v_shlf(I-1,J+1)))) / (3*G%dxT(i,j)) - uy = ((u_shlf(I,J) + (u_shlf(I-1,J) + u_shlf(I+1,J))) - & - (u_shlf(I,J-1) + (u_shlf(I-1,J-1) + u_shlf(I+1,J-1)))) / (3*G%dyT(i,j)) - vy = ((v_shlf(I,J) + (v_shlf(I-1,J)+ v_shlf(I+1,J))) - & - (v_shlf(I,J-1) + (v_shlf(I-1,J-1)+ v_shlf(I+1,J-1)))) / (3*G%dyT(i,j)) + do iq=1,2 ; do jq=1,2 + + ux = ( (u_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq,i,j) + & + u_shlf(I,J) * Phi(7,2*(jq-1)+iq,i,j)) + & + (u_shlf(I-1,J) * Phi(5,2*(jq-1)+iq,i,j) + & + u_shlf(I,J-1) * Phi(3,2*(jq-1)+iq,i,j)) ) + + vx = ( (v_shlf(I-1,J-1) * Phi(1,2*(jq-1)+iq,i,j) + & + v_shlf(I,J) * Phi(7,2*(jq-1)+iq,i,j)) + & + (v_shlf(I-1,J) * Phi(5,2*(jq-1)+iq,i,j) + & + v_shlf(I,J-1) * Phi(3,2*(jq-1)+iq,i,j)) ) + + uy = ( (u_shlf(I-1,J-1) * Phi(2,2*(jq-1)+iq,i,j) + & + u_shlf(I,J) * Phi(8,2*(jq-1)+iq,i,j)) + & + (u_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + & + u_shlf(I,J-1) * Phi(4,2*(jq-1)+iq,i,j)) ) + + vy = ( (v_shlf(I-1,j-1) * Phi(2,2*(jq-1)+iq,i,j) + & + v_shlf(I,J) * Phi(8,2*(jq-1)+iq,i,j)) + & + (v_shlf(I-1,J) * Phi(6,2*(jq-1)+iq,i,j) + & + v_shlf(I,J-1) * Phi(4,2*(jq-1)+iq,i,j)) ) + enddo ; enddo ! CS%ice_visc(i,j) =1e15*(G%areaT(i,j) * ISS%h_shelf(i,j)) ! constant viscocity for debugging CS%ice_visc(i,j) = 0.5 * Visc_coef * (G%areaT(i,j) * ISS%h_shelf(i,j)) * & (US%s_to_T**2 * (ux**2 + vy**2 + ux*vy + 0.25*(uy+vx)**2 + eps_min**2))**((1.-n_g)/(2.*n_g)) endif enddo enddo - + deallocate(Phi) end subroutine calc_shelf_visc subroutine calc_shelf_taub(CS, ISS, G, US, u_shlf, v_shlf) diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 469cba39ce..7cc3c020a3 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -149,14 +149,13 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U enddo ; enddo endif - if (len_sidestress > 0.) then do j=jsc,jec do i=isc,iec ! taper ice shelf in area where there is no sidestress - ! but do not interfere with hmask - if (G%geoLonCv(i,j) > len_sidestress) then + if ((len_sidestress > 0.) .and. (G%geoLonCv(i,j) > len_sidestress)) then udh = exp(-(G%geoLonCv(i,j)-len_sidestress)/5.0) * h_shelf(i,j) if (udh <= 25.0) then h_shelf(i,j) = 0.0 @@ -180,7 +179,6 @@ subroutine initialize_ice_thickness_from_file(h_shelf, area_shelf_h, hmask, G, U endif enddo enddo - endif end subroutine initialize_ice_thickness_from_file !> Initialize ice shelf thickness for a channel configuration @@ -397,13 +395,13 @@ end subroutine initialize_ice_shelf_boundary_channel !> Initialize ice shelf flow from file -subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& - hmask,h_shelf, G, US, PF) -!subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,ice_visc,float_cond,& +!subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& ! hmask,h_shelf, G, US, PF) +subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& + G, US, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: bed_elev !< The ice shelf u velocity [Z ~> m]. + intent(inout) :: bed_elev !< The bed elevation [Z ~> m]. real, dimension(SZIB_(G),SZJB_(G)), & intent(inout) :: u_shelf !< The zonal ice shelf velocity [L T-1 ~> m s-1]. real, dimension(SZIB_(G),SZJB_(G)), & @@ -412,12 +410,12 @@ subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& real, dimension(SZDI_(G),SZDJ_(G)), & intent(inout) :: float_cond !< An array indicating where the ice !! shelf is floating: 0 if floating, 1 if not. - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: hmask !< A mask indicating which tracer points are - !! partly or fully covered by an ice-shelf - real, dimension(SZDI_(G),SZDJ_(G)), & - intent(in) :: h_shelf !< A mask indicating which tracer points are +! real, dimension(SZDI_(G),SZDJ_(G)), & +! intent(in) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf +! real, dimension(SZDI_(G),SZDJ_(G)), & +! intent(in) :: h_shelf !< A mask indicating which tracer points are +! !! partly or fully covered by an ice-shelf type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters @@ -453,10 +451,10 @@ subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& "The name of the thickness variable in ICE_VELOCITY_FILE.", & default="viscosity") call get_param(PF, mdl, "BED_TOPO_FILE", bed_topo_file, & - "The file from which the velocity is read.", & + "The file from which the bed elevation is read.", & default="ice_shelf_vel.nc") call get_param(PF, mdl, "BED_TOPO_VARNAME", bed_varname, & - "The name of the thickness variable in ICE_VELOCITY_FILE.", & + "The name of the thickness variable in ICE_INPUT_FILE.", & default="depth") if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_ice_shelf_velocity_from_file: Unable to open "//trim(filename)) @@ -470,15 +468,8 @@ subroutine initialize_ice_flow_from_file(bed_elev,u_shelf, v_shelf,float_cond,& filename = trim(inputdir)//trim(bed_topo_file) call MOM_read_data(filename,trim(bed_varname), bed_elev, G%Domain, scale=1.) - isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec +! isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec -! do j=jsc,jec -! do i=isc,iec -! if (hmask(i,j) == 1.) then -! ice_visc(i,j) = ice_visc(i,j) * (G%areaT(i,j) * h_shelf(i,j)) -! endif -! enddo -! enddo end subroutine initialize_ice_flow_from_file @@ -510,7 +501,7 @@ subroutine initialize_ice_shelf_boundary_from_file(u_face_mask_bdry, v_face_mask intent(inout) :: hmask !< A mask indicating which tracer points are !! partly or fully covered by an ice-shelf real, dimension(SZDI_(G),SZDJ_(G)), & - intent(inout) :: h_shelf !< Ice-shelf thickness + intent(in) :: h_shelf !< Ice-shelf thickness type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors type(param_file_type), intent(in) :: PF !< A structure to parse for run-time parameters @@ -535,9 +526,9 @@ subroutine initialize_ice_shelf_boundary_from_file(u_face_mask_bdry, v_face_mask call get_param(PF, mdl, "ICE_THICKNESS_FILE", icethick_file, & "The file from which the ice-shelf thickness is read.", & default="ice_shelf_thick.nc") - call get_param(PF, mdl, "ICE_THICKNESS_VARNAME", h_varname, & - "The name of the thickness variable in ICE_THICKNESS_FILE.", & - default="h_shelf") +! call get_param(PF, mdl, "ICE_THICKNESS_VARNAME", h_varname, & +! "The name of the thickness variable in ICE_THICKNESS_FILE.", & +! default="h_shelf") call get_param(PF, mdl, "ICE_THICKNESS_MASK_VARNAME", hmsk_varname, & "The name of the icethickness mask variable in ICE_THICKNESS_FILE.", & default="h_mask") @@ -574,7 +565,7 @@ subroutine initialize_ice_shelf_boundary_from_file(u_face_mask_bdry, v_face_mask call MOM_read_data(filename,trim(vmask_varname), vmask, G%Domain, position=CORNER,scale=1.) filename = trim(inputdir)//trim(icethick_file) - call MOM_read_data(filename, trim(h_varname), h_shelf, G%Domain, scale=US%m_to_Z) +! call MOM_read_data(filename, trim(h_varname), h_shelf, G%Domain, scale=US%m_to_Z) call MOM_read_data(filename,trim(hmsk_varname), hmask, G%Domain, scale=1.) isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec From 12f29f67abdc6a8afb783e50159b1d9ffe014692 Mon Sep 17 00:00:00 2001 From: wfcooke Date: Fri, 17 Dec 2021 21:48:53 -0500 Subject: [PATCH 29/73] Adding temperature restore capability for SPEAR. (#36) * Adding temperature restore capability for SPEAR. Added parameter SPEAR_ECDA_SST_RESTORE_TFREEZE to allow activation of sea surface salinity based modification of restoring of temperature. The formula used is different from the Millero (default in SPEAR runs) scheme. * removed spaces on blank line. * (*)Changed hard wired value to parameter defined in MOM_override The freezing temperature came from SIS2 code. Changing the default value here to be consistent with that. (-0.054 vs -0.0539) The salinity restoring code used the -0.0539 value also so answers may change if using that code (RESTORE_SALINITY=T) * (*)Changed hard wired value to parameter defined in MOM_override The freezing temperature came from SIS2 code. Changing the default value here to be consistent with that. (-0.054 vs -0.0539) The salinity restoring code used the -0.0539 value also so answers may change if using that code (RESTORE_SALINITY=T) * Forgot to replace the salinity masking mulitplier with the override parameter --- .../FMS_cap/MOM_surface_forcing_gfdl.F90 | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index 09ba9e1156..cab870fed4 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -113,6 +113,8 @@ module MOM_surface_forcing_gfdl real :: Flux_const !< Piston velocity for surface restoring [Z T-1 ~> m s-1] real :: Flux_const_salt !< Piston velocity for surface salt restoring [Z T-1 ~> m s-1] real :: Flux_const_temp !< Piston velocity for surface temp restoring [Z T-1 ~> m s-1] + logical :: trestore_SPEAR_ECDA !< If true, modify restoring data wrt local SSS + real :: SPEAR_dTf_dS !< The derivative of the freezing temperature with salinity. logical :: salt_restore_as_sflux !< If true, SSS restore as salt flux instead of water flux logical :: adjust_net_srestore_to_zero !< Adjust srestore to zero (for both salt_flux or vprec) logical :: adjust_net_srestore_by_scaling !< Adjust srestore w/o moving zero contour @@ -346,7 +348,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, open_ocn_mask(:,:) = 1.0 if (CS%mask_srestore_under_ice) then ! Do not restore under sea-ice do j=js,je ; do i=is,ie - if (sfc_state%SST(i,j) <= -0.0539*sfc_state%SSS(i,j)) open_ocn_mask(i,j)=0.0 + if (sfc_state%SST(i,j) <= CS%SPEAR_dTf_dS*sfc_state%SSS(i,j)) open_ocn_mask(i,j)=0.0 enddo ; enddo endif if (CS%salt_restore_as_sflux) then @@ -400,6 +402,14 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! SST restoring logic if (CS%restore_temp) then call time_interp_external(CS%id_trestore, Time, data_restore) + if ( CS%trestore_SPEAR_ECDA ) then + do j=js,je ; do i=is,ie + if (abs(data_restore(i,j)+1.8)<0.0001) then + data_restore(i,j) = CS%SPEAR_dTf_dS*sfc_state%SSS(i,j) + endif + enddo ; enddo + endif + do j=js,je ; do i=is,ie delta_sst = data_restore(i,j)- sfc_state%SST(i,j) delta_sst = sign(1.0,delta_sst)*min(abs(delta_sst),CS%max_delta_trestore) @@ -1448,7 +1458,13 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) "If true, read a file (temp_restore_mask) containing "//& "a mask for SST restoring.", default=.false.) + call get_param(param_file, mdl, "SPEAR_ECDA_SST_RESTORE_TFREEZE", CS%trestore_SPEAR_ECDA, & + "If true, modify SST restoring field using SSS state. This only modifies the "//& + "restoring data that is within 0.0001degC of -1.8degC.", default=.false.) endif + call get_param(param_file, mdl, "SPEAR_DTFREEZE_DS", CS%SPEAR_dTf_dS, & + "The derivative of the freezing temperature with salinity.", & + units="deg C PSU-1", default=-0.054, do_not_log=.not.CS%trestore_SPEAR_ECDA) ! Optionally read tidal amplitude from input file [Z T-1 ~> m s-1] on model grid. ! Otherwise use default tidal amplitude for bottom frictionally-generated From a902e75845b38369bafdc9d0526300e5e8ff3bb0 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 13 Dec 2021 06:26:03 -0500 Subject: [PATCH 30/73] +Add US args and rescale dt arg to generic tracers Added unit_scaling_type arguments to various routines that had previously used a unit scaling type, but did so via the G%US pointer, to make the type dependencies more explicit and to avoid unnecessary pointer use. It had been the intention to make these arguments explicit from the time they were introduced via a pointer in the ocean_grid_type as a temporary convenience. The construct G%US%... was replaced with US%... wherever it was possible. Also rescaled some local variables or corrected comments in oil_tracer.F90, nw2_tracers.F90, and boundary_impulse_tracer.F90, and rescaled the units of the dt argument to MOM_generic_tracer_column_physics from [s] to [T ~> s]. All answers are bitwise identical, although there are multiple changes to public interfaces. --- src/core/MOM.F90 | 8 ++-- src/core/MOM_boundary_update.F90 | 4 +- src/core/MOM_variables.F90 | 10 ++-- src/diagnostics/MOM_sum_output.F90 | 11 +++-- .../MOM_state_initialization.F90 | 2 +- .../vertical/MOM_diabatic_driver.F90 | 48 +++++++++---------- src/tracer/MOM_CFC_cap.F90 | 5 +- src/tracer/MOM_OCMIP2_CFC.F90 | 5 +- src/tracer/MOM_generic_tracer.F90 | 32 +++++++------ src/tracer/MOM_tracer_Z_init.F90 | 2 +- src/tracer/MOM_tracer_flow_control.F90 | 37 +++++++------- src/tracer/advection_test_tracer.F90 | 5 +- src/tracer/boundary_impulse_tracer.F90 | 27 ++++++----- src/tracer/dye_example.F90 | 5 +- src/tracer/ideal_age_example.F90 | 5 +- src/tracer/nw2_tracers.F90 | 32 +++++++------ src/tracer/oil_tracer.F90 | 28 ++++++----- src/tracer/pseudo_salt_tracer.F90 | 5 +- src/tracer/tracer_example.F90 | 5 +- src/user/dyed_channel_initialization.F90 | 5 +- src/user/shelfwave_initialization.F90 | 2 +- src/user/supercritical_initialization.F90 | 11 ++--- src/user/tidal_bay_initialization.F90 | 7 +-- 23 files changed, 163 insertions(+), 138 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index db114ac3fa..ea54aece44 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1214,7 +1214,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) if (associated(CS%tv%T)) call hchksum(CS%tv%T, "Pre-advection T", G%HI, haloshift=1) if (associated(CS%tv%S)) call hchksum(CS%tv%S, "Pre-advection S", G%HI, haloshift=1) if (associated(CS%tv%frazil)) call hchksum(CS%tv%frazil, "Pre-advection frazil", G%HI, haloshift=0, & - scale=G%US%Q_to_J_kg*G%US%RZ_to_kg_m2) + scale=US%Q_to_J_kg*US%RZ_to_kg_m2) if (associated(CS%tv%salt_deficit)) call hchksum(CS%tv%salt_deficit, & "Pre-advection salt deficit", G%HI, haloshift=0, scale=US%RZ_to_kg_m2) ! call MOM_thermo_chksum("Pre-advection ", CS%tv, G, US) @@ -1445,7 +1445,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & if (associated(tv%T)) call hchksum(tv%T, "Post-diabatic T", G%HI, haloshift=1) if (associated(tv%S)) call hchksum(tv%S, "Post-diabatic S", G%HI, haloshift=1) if (associated(tv%frazil)) call hchksum(tv%frazil, "Post-diabatic frazil", G%HI, haloshift=0, & - scale=G%US%Q_to_J_kg*G%US%RZ_to_kg_m2) + scale=US%Q_to_J_kg*US%RZ_to_kg_m2) if (associated(tv%salt_deficit)) call hchksum(tv%salt_deficit, & "Post-diabatic salt deficit", G%HI, haloshift=0, scale=US%RZ_to_kg_m2) ! call MOM_thermo_chksum("Post-diabatic ", tv, G, US) @@ -3514,7 +3514,7 @@ subroutine extract_surface_state(CS, sfc_state_in) 'Extreme surface sfc_state detected: i=',ig,'j=',jg, & 'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), & 'x=',G%gridLonT(ig), 'y=',G%gridLatT(jg), & - 'D=',CS%US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',CS%US%Z_to_m*sfc_state%sea_lev(i,j), & + 'D=',US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',US%Z_to_m*sfc_state%sea_lev(i,j), & 'SST=',sfc_state%SST(i,j), 'SSS=',sfc_state%SSS(i,j), & 'U-=',US%L_T_to_m_s*sfc_state%u(I-1,j), 'U+=',US%L_T_to_m_s*sfc_state%u(I,j), & 'V-=',US%L_T_to_m_s*sfc_state%v(i,J-1), 'V+=',US%L_T_to_m_s*sfc_state%v(i,J) @@ -3523,7 +3523,7 @@ subroutine extract_surface_state(CS, sfc_state_in) 'Extreme surface sfc_state detected: i=',ig,'j=',jg, & 'lon=',G%geoLonT(i,j), 'lat=',G%geoLatT(i,j), & 'x=',G%gridLonT(i), 'y=',G%gridLatT(j), & - 'D=',CS%US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',CS%US%Z_to_m*sfc_state%sea_lev(i,j), & + 'D=',US%Z_to_m*(G%bathyT(i,j)+G%Z_ref), 'SSH=',US%Z_to_m*sfc_state%sea_lev(i,j), & 'U-=',US%L_T_to_m_s*sfc_state%u(I-1,j), 'U+=',US%L_T_to_m_s*sfc_state%u(I,j), & 'V-=',US%L_T_to_m_s*sfc_state%v(i,J-1), 'V+=',US%L_T_to_m_s*sfc_state%v(i,J) endif diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90 index 286cec20d4..11973f8c02 100644 --- a/src/core/MOM_boundary_update.F90 +++ b/src/core/MOM_boundary_update.F90 @@ -147,13 +147,13 @@ subroutine update_OBC_data(OBC, G, GV, US, tv, h, CS, Time) ! if (CS%use_files) & ! call update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (CS%use_tidal_bay) & - call tidal_bay_set_OBC_data(OBC, CS%tidal_bay_OBC, G, GV, h, Time) + call tidal_bay_set_OBC_data(OBC, CS%tidal_bay_OBC, G, GV, US, h, Time) if (CS%use_Kelvin) & call Kelvin_set_OBC_data(OBC, CS%Kelvin_OBC_CSp, G, GV, US, h, Time) if (CS%use_shelfwave) & call shelfwave_set_OBC_data(OBC, CS%shelfwave_OBC_CSp, G, GV, US, h, Time) if (CS%use_dyed_channel) & - call dyed_channel_update_flow(OBC, CS%dyed_channel_OBC_CSp, G, GV, Time) + call dyed_channel_update_flow(OBC, CS%dyed_channel_OBC_CSp, G, GV, US, Time) if (OBC%needs_IO_for_data .or. OBC%add_tide_constituents) & call update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index f61879845a..5de7ea7319 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -11,6 +11,7 @@ module MOM_variables use MOM_EOS, only : EOS_type use MOM_error_handler, only : MOM_error, FATAL use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -562,10 +563,11 @@ subroutine dealloc_BT_cont_type(BT_cont) end subroutine dealloc_BT_cont_type !> Diagnostic checksums on various elements of a thermo_var_ptrs type for debugging. -subroutine MOM_thermovar_chksum(mesg, tv, G) +subroutine MOM_thermovar_chksum(mesg, tv, G, US) character(len=*), intent(in) :: mesg !< A message that appears in the checksum lines type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Note that for the chksum calls to be useful for reproducing across PE ! counts, there must be no redundant points, so all variables use is..ie @@ -575,11 +577,11 @@ subroutine MOM_thermovar_chksum(mesg, tv, G) if (associated(tv%S)) & call hchksum(tv%S, mesg//" tv%S", G%HI) if (associated(tv%frazil)) & - call hchksum(tv%frazil, mesg//" tv%frazil", G%HI, scale=G%US%Q_to_J_kg*G%US%RZ_to_kg_m2) + call hchksum(tv%frazil, mesg//" tv%frazil", G%HI, scale=US%Q_to_J_kg*US%RZ_to_kg_m2) if (associated(tv%salt_deficit)) & - call hchksum(tv%salt_deficit, mesg//" tv%salt_deficit", G%HI, scale=G%US%RZ_to_kg_m2) + call hchksum(tv%salt_deficit, mesg//" tv%salt_deficit", G%HI, scale=US%RZ_to_kg_m2) if (associated(tv%TempxPmE)) & - call hchksum(tv%TempxPmE, mesg//" tv%TempxPmE", G%HI, scale=G%US%RZ_to_kg_m2) + call hchksum(tv%TempxPmE, mesg//" tv%TempxPmE", G%HI, scale=US%RZ_to_kg_m2) end subroutine MOM_thermovar_chksum end module MOM_variables diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 3b6fb0c510..668c297658 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -532,7 +532,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci nTr_stocks = 0 Tr_minmax_avail(:) = .false. - call call_tracer_stocks(h, Tr_stocks, G, GV, tracer_CSp, stock_names=Tr_names, & + call call_tracer_stocks(h, Tr_stocks, G, GV, US, tracer_CSp, stock_names=Tr_names, & stock_units=Tr_units, num_stocks=nTr_stocks,& got_min_max=Tr_minmax_avail, global_min=Tr_min, global_max=Tr_max, & xgmin=Tr_min_x, ygmin=Tr_min_y, zgmin=Tr_min_z,& @@ -1248,7 +1248,7 @@ subroutine write_depth_list(G, US, DL, filename) character(len=16) :: depth_chksum, area_chksum ! All ranks are required to compute the global checksum - call get_depth_list_checksums(G, depth_chksum, area_chksum) + call get_depth_list_checksums(G, US, depth_chksum, area_chksum) if (.not.is_root_pe()) return @@ -1313,7 +1313,7 @@ subroutine read_depth_list(G, US, DL, filename, require_chksum, file_matches) call MOM_error(WARNING, trim(var_msg) // " some diagnostics may not be reproducible.") endif else - call get_depth_list_checksums(G, depth_grid_chksum, area_grid_chksum) + call get_depth_list_checksums(G, US, depth_grid_chksum, area_grid_chksum) if ((trim(depth_grid_chksum) /= trim(depth_file_chksum)) .or. & (trim(area_grid_chksum) /= trim(area_file_chksum)) ) then @@ -1360,8 +1360,9 @@ end subroutine read_depth_list !! !! Checksums are saved as hexadecimal strings, in order to avoid potential !! datatype issues with netCDF attributes. -subroutine get_depth_list_checksums(G, depth_chksum, area_chksum) +subroutine get_depth_list_checksums(G, US, depth_chksum, area_chksum) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type character(len=16), intent(out) :: depth_chksum !< Depth checksum hexstring character(len=16), intent(out) :: area_chksum !< Area checksum hexstring @@ -1378,7 +1379,7 @@ subroutine get_depth_list_checksums(G, depth_chksum, area_chksum) ! Area checksum do j=G%jsc,G%jec ; do i=G%isc,G%iec - field(i,j) = G%mask2dT(i,j) * G%US%L_to_m**2*G%areaT(i,j) + field(i,j) = G%mask2dT(i,j) * US%L_to_m**2*G%areaT(i,j) enddo ; enddo write(area_chksum, '(Z16)') field_chksum(field(:,:)) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 2aab378b4a..8055440cce 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -620,7 +620,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & elseif (trim(config) == "shelfwave") then OBC%update_OBC = .true. elseif (lowercase(trim(config)) == "supercritical") then - call supercritical_set_OBC_data(OBC, G, GV, PF) + call supercritical_set_OBC_data(OBC, G, GV, US, PF) elseif (trim(config) == "tidal_bay") then OBC%update_OBC = .true. elseif (trim(config) == "USER") then diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 77ec87b230..c123e60800 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -601,7 +601,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after set_diffusivity ", tv, G) + call MOM_thermovar_chksum("after set_diffusivity ", tv, G, US) call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif @@ -678,7 +678,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_state_chksum("after KPP", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after KPP", tv, G) + call MOM_thermovar_chksum("after KPP", tv, G, US) call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) @@ -699,7 +699,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) + call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G, US) endif endif ! endif for KPP @@ -747,7 +747,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after calc_entrain ", tv, G) + call MOM_thermovar_chksum("after calc_entrain ", tv, G, US) call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, US, haloshift=0) call hchksum(ent_s, "after calc_entrain ent_s", G%HI, haloshift=0, scale=GV%H_to_m) endif @@ -842,7 +842,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_end(id_clock_remap) if (CS%debug) then call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) + call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G, US) call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, US, haloshift=0) endif if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") @@ -851,7 +851,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_state_chksum("after negative check ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after negative check ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after negative check ", tv, G) + call MOM_thermovar_chksum("after negative check ", tv, G, US) endif if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G, GV, US) @@ -908,7 +908,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("after mixed layer ", tv, G) + call MOM_thermovar_chksum("after mixed layer ", tv, G, US) endif ! Whenever thickness changes let the diag manager know, as the @@ -1020,7 +1020,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_end(id_clock_sponge) if (CS%debug) then call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("apply_sponge ", tv, G) + call MOM_thermovar_chksum("apply_sponge ", tv, G, US) endif endif ! CS%use_sponge @@ -1032,7 +1032,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_end(id_clock_oda_incupd) if (CS%debug) then call MOM_state_chksum("apply_oda_incupd ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("apply_oda_incupd ", tv, G) + call MOM_thermovar_chksum("apply_oda_incupd ", tv, G, US) endif endif ! CS%use_oda_incupd @@ -1185,7 +1185,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%debug) then call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after set_diffusivity ", tv, G) + call MOM_thermovar_chksum("after set_diffusivity ", tv, G, US) call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif @@ -1253,7 +1253,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%debug) then call MOM_state_chksum("after KPP", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after KPP", tv, G) + call MOM_thermovar_chksum("after KPP", tv, G, US) call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) @@ -1274,7 +1274,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%debug) then call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) + call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G, US) endif endif ! endif for KPP @@ -1372,7 +1372,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_end(id_clock_remap) if (CS%debug) then call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) + call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G, US) call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, US, haloshift=0) endif if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") @@ -1439,7 +1439,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%debug) then call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("after mixed layer ", tv, G) + call MOM_thermovar_chksum("after mixed layer ", tv, G, US) endif ! Whenever thickness changes let the diag manager know, as the @@ -1526,7 +1526,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_end(id_clock_sponge) if (CS%debug) then call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("apply_sponge ", tv, G) + call MOM_thermovar_chksum("apply_sponge ", tv, G, US) endif endif ! CS%use_sponge @@ -1538,7 +1538,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_end(id_clock_oda_incupd) if (CS%debug) then call MOM_state_chksum("apply_oda_incupd ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("apply_oda_incupd ", tv, G) + call MOM_thermovar_chksum("apply_oda_incupd ", tv, G, US) endif endif ! CS%use_oda_incupd @@ -1789,7 +1789,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after set_diffusivity ", tv, G) + call MOM_thermovar_chksum("after set_diffusivity ", tv, G, US) call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif @@ -1863,7 +1863,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_state_chksum("after KPP", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after KPP", tv, G) + call MOM_thermovar_chksum("after KPP", tv, G, US) call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif @@ -1896,7 +1896,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) + call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G, US) endif endif ! endif for KPP @@ -1934,7 +1934,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after calc_entrain ", tv, G) + call MOM_thermovar_chksum("after calc_entrain ", tv, G, US) call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, US, haloshift=0) call hchksum(ea, "after calc_entrain ea", G%HI, haloshift=0, scale=GV%H_to_m) call hchksum(eb, "after calc_entrain eb", G%HI, haloshift=0, scale=GV%H_to_m) @@ -1985,7 +1985,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_state_chksum("after negative check ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after negative check ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after negative check ", tv, G) + call MOM_thermovar_chksum("after negative check ", tv, G, US) endif if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G, GV, US) @@ -2183,7 +2183,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("after mixed layer ", tv, G) + call MOM_thermovar_chksum("after mixed layer ", tv, G, US) call hchksum(ea, "after mixed layer ea", G%HI, scale=GV%H_to_m) call hchksum(eb, "after mixed layer eb", G%HI, scale=GV%H_to_m) endif @@ -2331,7 +2331,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_end(id_clock_sponge) if (CS%debug) then call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("apply_sponge ", tv, G) + call MOM_thermovar_chksum("apply_sponge ", tv, G, US) endif endif ! CS%use_sponge @@ -2342,7 +2342,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_end(id_clock_oda_incupd) if (CS%debug) then call MOM_state_chksum("apply_oda_incupd ", u, v, h, G, GV, US, haloshift=0) - call MOM_thermovar_chksum("apply_oda_incupd ", tv, G) + call MOM_thermovar_chksum("apply_oda_incupd ", tv, G, US) endif endif ! CS%use_oda_incupd diff --git a/src/tracer/MOM_CFC_cap.F90 b/src/tracer/MOM_CFC_cap.F90 index 79df57cc23..7296f1d469 100644 --- a/src/tracer/MOM_CFC_cap.F90 +++ b/src/tracer/MOM_CFC_cap.F90 @@ -341,13 +341,14 @@ end subroutine CFC_cap_column_physics !> Calculates the mass-weighted integral of all tracer stocks, !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function CFC_cap_stock(h, stocks, G, GV, CS, names, units, stock_index) +function CFC_cap_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(CFC_cap_CS), pointer :: CS !< The control structure returned by a !! previous call to register_CFC_cap. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. @@ -376,7 +377,7 @@ function CFC_cap_stock(h, stocks, G, GV, CS, names, units, stock_index) call query_vardesc(CS%CFC12_desc, name=names(2), units=units(2), caller="CFC_cap_stock") units(1) = trim(units(1))//" kg" ; units(2) = trim(units(2))//" kg" - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 stocks(1) = 0.0 ; stocks(2) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie mass = G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k) diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 38193a3abc..5fe55b896b 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -478,13 +478,14 @@ end subroutine OCMIP2_CFC_column_physics !> This function calculates the mass-weighted integral of all tracer stocks, !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) +function OCMIP2_CFC_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a !! previous call to register_OCMIP2_CFC. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. @@ -513,7 +514,7 @@ function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) call query_vardesc(CS%CFC12_desc, name=names(2), units=units(2), caller="OCMIP2_CFC_stock") units(1) = trim(units(1))//" kg" ; units(2) = trim(units(2))//" kg" - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 stocks(1) = 0.0 ; stocks(2) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie mass = G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k) diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index 4627d0ec80..bf9f01e266 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -395,7 +395,7 @@ end subroutine initialize_MOM_generic_tracer !! tracer physics or chemistry to the tracers from this file. !! CFCs are relatively simple, as they are passive tracers. with only a surface !! flux as a source. - subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, CS, tv, optics, & + subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, US, CS, tv, optics, & evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -412,7 +412,8 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic !! and tracer forcing fields. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Hml !< Mixed layer depth [Z ~> m] - real, intent(in) :: dt !< The amount of time covered by this call [s] + real, intent(in) :: dt !< The amount of time covered by this call [T ~> s] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables type(optics_type), intent(in) :: optics !< The structure containing optical properties. @@ -469,7 +470,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, call g_tracer_get_pointer(g_tracer,g_tracer_name,'runoff_tracer_flux',runoff_tracer_flux_array) !nnz: Why is fluxes%river = 0? runoff_tracer_flux_array(:,:) = trunoff_array(:,:) * & - G%US%RZ_T_to_kg_m2s*fluxes%lrunoff(:,:) + US%RZ_T_to_kg_m2s*fluxes%lrunoff(:,:) stf_array = stf_array + runoff_tracer_flux_array endif @@ -496,25 +497,25 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dz_ml(:,:) = 0.0 do j=jsc,jec ; do i=isc,iec surface_field(i,j) = tv%S(i,j,1) - dz_ml(i,j) = G%US%Z_to_m * Hml(i,j) + dz_ml(i,j) = US%Z_to_m * Hml(i,j) enddo ; enddo sosga = global_area_mean(surface_field, G) ! !Calculate tendencies (i.e., field changes at dt) from the sources / sinks ! - if ((G%US%L_to_m == 1.0) .and. (G%US%RZ_to_kg_m2 == 1.0) .and. (G%US%s_to_T == 1.0)) then + if ((US%L_to_m == 1.0) .and. (US%RZ_to_kg_m2 == 1.0) .and. (US%s_to_T == 1.0)) then ! Avoid unnecessary copies when no unit conversion is needed. call generic_tracer_source(tv%T, tv%S, rho_dzt, dzt, dz_ml, G%isd, G%jsd, 1, dt, & G%areaT, get_diag_time_end(CS%diag), & optics%nbands, optics%max_wavelength_band, optics%sw_pen_band, optics%opacity_band, & internal_heat=tv%internal_heat, frunoff=fluxes%frunoff, sosga=sosga) else - call generic_tracer_source(tv%T, tv%S, rho_dzt, dzt, dz_ml, G%isd, G%jsd, 1, dt, & - G%US%L_to_m**2*G%areaT(:,:), get_diag_time_end(CS%diag), & + call generic_tracer_source(tv%T, tv%S, rho_dzt, dzt, dz_ml, G%isd, G%jsd, 1, US%T_to_s*dt, & + US%L_to_m**2*G%areaT(:,:), get_diag_time_end(CS%diag), & optics%nbands, optics%max_wavelength_band, optics%sw_pen_band, optics%opacity_band, & - internal_heat=G%US%RZ_to_kg_m2*tv%internal_heat(:,:), & - frunoff=G%US%RZ_T_to_kg_m2s*fluxes%frunoff(:,:), sosga=sosga) + internal_heat=US%RZ_to_kg_m2*tv%internal_heat(:,:), & + frunoff=US%RZ_T_to_kg_m2s*fluxes%frunoff(:,:), sosga=sosga) endif ! This uses applyTracerBoundaryFluxesInOut to handle the change in tracer due to freshwater fluxes @@ -526,7 +527,7 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, do k=1,nk ;do j=jsc,jec ; do i=isc,iec h_work(i,j,k) = h_old(i,j,k) enddo ; enddo ; enddo - call applyTracerBoundaryFluxesInOut(G, GV, g_tracer%field(:,:,:,1), G%US%s_to_T*dt, & + call applyTracerBoundaryFluxesInOut(G, GV, g_tracer%field(:,:,:,1), dt, & fluxes, h_work, evap_CFL_limit, minimum_forcing_depth) endif @@ -544,16 +545,16 @@ subroutine MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, ! surface source is applied and diapycnal advection and diffusion occurs. if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then ! Last arg is tau which is always 1 for MOM6 - call generic_tracer_vertdiff_G(h_work, ea, eb, dt, GV%kg_m2_to_H, GV%m_to_H, 1) + call generic_tracer_vertdiff_G(h_work, ea, eb, US%T_to_s*dt, GV%kg_m2_to_H, GV%m_to_H, 1) else ! Last arg is tau which is always 1 for MOM6 - call generic_tracer_vertdiff_G(h_old, ea, eb, dt, GV%kg_m2_to_H, GV%m_to_H, 1) + call generic_tracer_vertdiff_G(h_old, ea, eb, US%T_to_s*dt, GV%kg_m2_to_H, GV%m_to_H, 1) endif ! Update bottom fields after vertical processes ! Second arg is tau which is always 1 for MOM6 - call generic_tracer_update_from_bottom(dt, 1, get_diag_time_end(CS%diag)) + call generic_tracer_update_from_bottom(US%T_to_s*dt, 1, get_diag_time_end(CS%diag)) !Output diagnostics via diag_manager for all generic tracers and their fluxes call g_tracer_send_diag(CS%g_tracer_list, get_diag_time_end(CS%diag), tau=1) @@ -568,12 +569,13 @@ end subroutine MOM_generic_tracer_column_physics !! being requested specifically, returning the number of stocks it has !! calculated. If the stock_index is present, only the stock corresponding !! to that coded index is returned. - function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) + function MOM_generic_tracer_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< The mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. @@ -604,7 +606,7 @@ function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_inde if (.NOT. associated(CS%g_tracer_list)) return ! No stocks. - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 m=1 ; g_tracer=>CS%g_tracer_list do call g_tracer_get_alias(g_tracer,names(m)) diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 1be976d3f2..e8324b6043 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -565,7 +565,7 @@ subroutine determine_temperature(temp, salt, R_tgt, p_ref, niter, land_fill, h, real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: temp !< potential temperature [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: salt !< salinity [PSU] + intent(inout) :: salt !< salinity [ppt] real, dimension(SZK_(GV)), intent(in) :: R_tgt !< desired potential density [R ~> kg m-3]. real, intent(in) :: p_ref !< reference pressure [R L2 T-2 ~> Pa]. integer, intent(in) :: niter !< maximum number of iterations diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 4278594913..2ae72a3270 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -262,13 +262,13 @@ subroutine call_tracer_register(HI, GV, US, param_file, CS, tr_Reg, restart_CS) register_pseudo_salt_tracer(HI, GV, param_file, CS%pseudo_salt_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_boundary_impulse_tracer) CS%use_boundary_impulse_tracer = & - register_boundary_impulse_tracer(HI, GV, param_file, CS%boundary_impulse_tracer_CSp, & + register_boundary_impulse_tracer(HI, GV, US, param_file, CS%boundary_impulse_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_dyed_obc_tracer) CS%use_dyed_obc_tracer = & register_dyed_obc_tracer(HI, GV, param_file, CS%dyed_obc_tracer_CSp, & tr_Reg, restart_CS) if (CS%use_nw2_tracers) CS%use_nw2_tracers = & - register_nw2_tracers(HI, GV, param_file, CS%nw2_tracers_CSp, tr_Reg, restart_CS) + register_nw2_tracers(HI, GV, US, param_file, CS%nw2_tracers_CSp, tr_Reg, restart_CS) end subroutine call_tracer_register @@ -346,7 +346,7 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag call initialize_pseudo_salt_tracer(restart, day, G, GV, h, diag, OBC, CS%pseudo_salt_tracer_CSp, & sponge_CSp, tv) if (CS%use_boundary_impulse_tracer) & - call initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, CS%boundary_impulse_tracer_CSp, & + call initialize_boundary_impulse_tracer(restart, day, G, GV, US, h, diag, OBC, CS%boundary_impulse_tracer_CSp, & sponge_CSp, tv) if (CS%use_dyed_obc_tracer) & call initialize_dyed_obc_tracer(restart, day, G, GV, h, diag, OBC, CS%dyed_obc_tracer_CSp) @@ -495,8 +495,8 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, if (US%QRZ_T_to_W_m2 /= 1.0) call MOM_error(FATAL, "MOM_generic_tracer_column_physics "//& "has not been written to permit dimensionsal rescaling. Set all 4 of the "//& "[QRZT]_RESCALE_POWER parameters to 0.") - call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, US%T_to_s*dt, & - G, GV, CS%MOM_generic_tracer_CSp, tv, optics, & + call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, & + G, GV, US, CS%MOM_generic_tracer_CSp, tv, optics, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) endif @@ -555,8 +555,8 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, if (US%QRZ_T_to_W_m2 /= 1.0) call MOM_error(FATAL, "MOM_generic_tracer_column_physics "//& "has not been written to permit dimensionsal rescaling. Set all 4 of the "//& "[QRZT]_RESCALE_POWER parameters to 0.") - call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, US%T_to_s*dt, & - G, GV, CS%MOM_generic_tracer_CSp, tv, optics) + call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, & + G, GV, US, CS%MOM_generic_tracer_CSp, tv, optics) endif if (CS%use_pseudo_salt_tracer) & call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & @@ -575,7 +575,7 @@ end subroutine call_tracer_column_fns !> This subroutine calls all registered tracer packages to enable them to !! add to the surface state returned to the coupler. These routines are optional. -subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_units, & +subroutine call_tracer_stocks(h, stock_values, G, GV, US, CS, stock_names, stock_units, & num_stocks, stock_index, got_min_max, global_min, global_max, & xgmin, ygmin, zgmin, xgmax, ygmax, zgmax) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -584,6 +584,7 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stock_values !< The integrated amounts of a tracer !! on the current PE, usually in kg x concentration [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a !! previous call to !! call_tracer_register. @@ -624,7 +625,7 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni ! Add other user-provided calls here. if (CS%use_USER_tracer_example) then - ns = USER_tracer_stock(h, values, G, GV, CS%USER_tracer_example_CSp, & + ns = USER_tracer_stock(h, values, G, GV, US, CS%USER_tracer_example_CSp, & names, units, stock_index) call store_stocks("tracer_example", ns, names, units, values, index, stock_values, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) @@ -636,44 +637,44 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni ! set_pkg_name, max_ns, ns_tot, stock_names, stock_units) ! endif if (CS%use_ideal_age) then - ns = ideal_age_stock(h, values, G, GV, CS%ideal_age_tracer_CSp, & + ns = ideal_age_stock(h, values, G, GV, US, CS%ideal_age_tracer_CSp, & names, units, stock_index) call store_stocks("ideal_age_example", ns, names, units, values, index, & stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_regional_dyes) then - ns = dye_stock(h, values, G, GV, CS%dye_tracer_CSp, & + ns = dye_stock(h, values, G, GV, US, CS%dye_tracer_CSp, & names, units, stock_index) call store_stocks("regional_dyes", ns, names, units, values, index, & stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_oil) then - ns = oil_stock(h, values, G, GV, CS%oil_tracer_CSp, & + ns = oil_stock(h, values, G, GV, US, CS%oil_tracer_CSp, & names, units, stock_index) call store_stocks("oil_tracer", ns, names, units, values, index, & stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_OCMIP2_CFC) then - ns = OCMIP2_CFC_stock(h, values, G, GV, CS%OCMIP2_CFC_CSp, names, units, stock_index) + ns = OCMIP2_CFC_stock(h, values, G, GV, US, CS%OCMIP2_CFC_CSp, names, units, stock_index) call store_stocks("MOM_OCMIP2_CFC", ns, names, units, values, index, stock_values, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_CFC_cap) then - ns = CFC_cap_stock(h, values, G, GV, CS%CFC_cap_CSp, names, units, stock_index) + ns = CFC_cap_stock(h, values, G, GV, US, CS%CFC_cap_CSp, names, units, stock_index) call store_stocks("MOM_CFC_cap", ns, names, units, values, index, stock_values, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_advection_test_tracer) then - ns = advection_test_stock( h, values, G, GV, CS%advection_test_tracer_CSp, & + ns = advection_test_stock( h, values, G, GV, US, CS%advection_test_tracer_CSp, & names, units, stock_index ) call store_stocks("advection_test_tracer", ns, names, units, values, index, & stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_MOM_generic_tracer) then - ns = MOM_generic_tracer_stock(h, values, G, GV, CS%MOM_generic_tracer_CSp, & + ns = MOM_generic_tracer_stock(h, values, G, GV, US, CS%MOM_generic_tracer_CSp, & names, units, stock_index) call store_stocks("MOM_generic_tracer", ns, names, units, values, index, stock_values, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) @@ -684,14 +685,14 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni endif if (CS%use_pseudo_salt_tracer) then - ns = pseudo_salt_stock(h, values, G, GV, CS%pseudo_salt_tracer_CSp, & + ns = pseudo_salt_stock(h, values, G, GV, US, CS%pseudo_salt_tracer_CSp, & names, units, stock_index) call store_stocks("pseudo_salt_tracer", ns, names, units, values, index, & stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_boundary_impulse_tracer) then - ns = boundary_impulse_stock(h, values, G, GV, CS%boundary_impulse_tracer_CSp, & + ns = boundary_impulse_stock(h, values, G, GV, US, CS%boundary_impulse_tracer_CSp, & names, units, stock_index) call store_stocks("boundary_impulse_tracer", ns, names, units, values, index, & stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index b713803182..8fdb525b4a 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -344,12 +344,13 @@ end subroutine advection_test_tracer_surface_state !> Calculate the mass-weighted integral of all tracer stocks, returning the number of stocks it has calculated. !! If the stock_index is present, only the stock corresponding to that coded index is returned. -function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) +function advection_test_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_advection_test_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. @@ -373,7 +374,7 @@ function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="advection_test_stock") stocks(m) = 0.0 diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 18e9b8dc8e..ea60a09608 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -46,9 +46,8 @@ module boundary_impulse_tracer integer :: nkml !< Number of layers in mixed layer real, dimension(NTR_MAX) :: land_val = -1.0 !< A value to use to fill in tracers over land - real :: kw_eff !< An effective piston velocity used to flux tracer out at the surface real :: remaining_source_time !< How much longer (same units as the timestep) to - !! inject the tracer at the surface [s] + !! inject the tracer at the surface [T ~> s] type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. @@ -60,9 +59,10 @@ module boundary_impulse_tracer contains !> Read in runtime options and add boundary impulse tracer to tracer registry -function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) +function register_boundary_impulse_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in ) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in ) :: US !< A dimensional unit scaling type type(param_file_type), intent(in ) :: param_file !< A structure to parse for run-time parameters type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_boundary_impulse_tracer. @@ -79,7 +79,7 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar character(len=48) :: flux_units ! The units for tracer fluxes, usually ! kg(tracer) kg(water)-1 m3 s-1 or kg(tracer) s-1. ! This include declares and sets the variable "version". -#include "version_variable.h" +# include "version_variable.h" real, pointer :: tr_ptr(:,:,:) => NULL() real, pointer :: rem_time_ptr => NULL() logical :: register_boundary_impulse_tracer @@ -99,7 +99,7 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar "Length of time for the boundary tracer to be injected "//& "into the mixed layer. After this time has elapsed, the "//& "surface becomes a sink for the boundary impulse tracer.", & - default=31536000.0) + default=31536000.0, scale=US%s_to_T) call get_param(param_file, mdl, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, & "If true, tracers may go through the initialization code "//& "if they are not found in the restart files. Otherwise "//& @@ -145,13 +145,14 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar end function register_boundary_impulse_tracer !> Initialize tracer from restart or set to 1 at surface to initialize -subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, CS, & +subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & sponge_CSp, tv) logical, intent(in) :: restart !< .true. if the fields have already !! been read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate @@ -186,14 +187,17 @@ subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=name, caller="initialize_boundary_impulse_tracer") - if ((.not.restart) .or. (.not. & - query_initialized(CS%tr(:,:,:,m), name, CS%restart_CSp))) then + if ((.not.restart) .or. (.not. query_initialized(CS%tr(:,:,:,m), name, CS%restart_CSp))) then do k=1,CS%nkml ; do j=jsd,jed ; do i=isd,ied CS%tr(i,j,k,m) = 1.0 enddo ; enddo ; enddo endif enddo ! Tracer loop + if (restart .and. (US%s_to_T_restart /= 0.0) .and. (US%s_to_T /= US%s_to_T_restart) ) then + CS%remaining_source_time = (US%s_to_T / US%s_to_T_restart) * CS%remaining_source_time + endif + if (associated(OBC)) then ! Steal from updated DOME in the fullness of time. endif @@ -268,7 +272,7 @@ subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, do k=1,CS%nkml ; do j=js,je ; do i=is,ie CS%tr(i,j,k,m) = 1.0 enddo ; enddo ; enddo - CS%remaining_source_time = CS%remaining_source_time-US%T_to_s*dt + CS%remaining_source_time = CS%remaining_source_time-dt else do k=1,CS%nkml ; do j=js,je ; do i=is,ie CS%tr(i,j,k,m) = 0.0 @@ -283,12 +287,13 @@ end subroutine boundary_impulse_tracer_column_physics !> This function calculates the mass-weighted integral of the boundary impulse, !! tracer stocks returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) +function boundary_impulse_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in ) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in ) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent( out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. + type(unit_scale_type), intent(in ) :: US !< A dimensional unit scaling type type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_boundary_impulse_tracer. character(len=*), dimension(:), intent( out) :: names !< The names of the stocks calculated. @@ -317,7 +322,7 @@ function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,1 call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="boundary_impulse_stock") units(m) = trim(units(m))//" kg" diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 91806bb94e..dca01e974a 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -325,12 +325,13 @@ end subroutine dye_tracer_column_physics !> This function calculates the mass-weighted integral of all tracer stocks, !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function dye_stock(h, stocks, G, GV, CS, names, units, stock_index) +function dye_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of !! each tracer, in kg times concentration units [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(dye_tracer_CS), pointer :: CS !< The control structure returned by a !! previous call to register_dye_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. @@ -356,7 +357,7 @@ function dye_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="dye_stock") units(m) = trim(units(m))//" kg" diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index ca47a8ca1d..d5c813b3d0 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -369,13 +369,14 @@ end subroutine ideal_age_tracer_column_physics !> Calculates the mass-weighted integral of all tracer stocks, returning the number of stocks it !! has calculated. If stock_index is present, only the stock corresponding to that coded index is found. -function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) +function ideal_age_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_ideal_age_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. @@ -400,7 +401,7 @@ function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="ideal_age_stock") units(m) = trim(units(m))//" kg" diff --git a/src/tracer/nw2_tracers.F90 b/src/tracer/nw2_tracers.F90 index fcb9f3e854..0e66ebbcf3 100644 --- a/src/tracer/nw2_tracers.F90 +++ b/src/tracer/nw2_tracers.F90 @@ -33,7 +33,8 @@ module nw2_tracers type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the tracer registry real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package, in g m-3? - real, allocatable , dimension(:) :: restore_rate !< The exponential growth rate for restoration value [year-1]. + real, allocatable , dimension(:) :: restore_rate !< The rate at which the tracer is damped toward + !! its target profile [T-1 ~> s-1] type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart controls structure @@ -42,9 +43,10 @@ module nw2_tracers contains !> Register the NW2 tracer fields to be used with MOM. -logical function register_nw2_tracers(HI, GV, param_file, CS, tr_Reg, restart_CS) +logical function register_nw2_tracers(HI, GV, US, param_file, CS, tr_Reg, restart_CS) type(hor_index_type), intent(in) :: HI !< A horizontal index type structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(nw2_tracers_CS), pointer :: CS !< The control structure returned by a previous !! call to register_nw2_tracer. @@ -62,7 +64,7 @@ logical function register_nw2_tracers(HI, GV, param_file, CS, tr_Reg, restart_CS logical :: do_nw2 integer :: isd, ied, jsd, jed, nz, m, ig integer :: n_groups ! Number of groups of three tracers (i.e. # tracers/3) - real, allocatable, dimension(:) :: timescale_in_days + real, allocatable, dimension(:) :: timescale_in_days ! Damping timescale [days] type(vardesc) :: tr_desc ! Descriptions and metadata for the tracers isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke @@ -100,7 +102,7 @@ logical function register_nw2_tracers(HI, GV, param_file, CS, tr_Reg, restart_CS call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, tr_desc=tr_desc, & registry_diags=.true., restart_CS=restart_CS, mandatory=.false.) ig = int( (m+2)/3 ) ! maps (1,2,3)->1, (4,5,6)->2, ... - CS%restore_rate(m) = 1.0 / ( timescale_in_days(ig) * 86400.0 ) + CS%restore_rate(m) = 1.0 / ( timescale_in_days(ig) * 86400.0*US%s_to_T ) enddo CS%tr_Reg => tr_Reg @@ -125,8 +127,8 @@ subroutine initialize_nw2_tracers(restart, day, G, GV, US, h, tv, diag, CS) type(nw2_tracers_CS), pointer :: CS !< The control structure returned by a previous !! call to register_nw2_tracer. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights - real :: rscl ! z* scaling factor + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights [Z ~> m] + real :: rscl ! z* scaling factor [nondim] character(len=8) :: var_name ! The variable's name. integer :: i, j, k, m @@ -206,11 +208,11 @@ subroutine nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US ! The arguments to this subroutine are redundant in that ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights [Z ~> m] integer :: i, j, k, m - real :: dt_x_rate ! dt * restoring rate - real :: rscl ! z* scaling factor + real :: dt_x_rate ! dt * restoring rate [nondim] + real :: rscl ! z* scaling factor [nondim] real :: target_value ! tracer value ! if (.not.associated(CS)) return @@ -253,8 +255,8 @@ subroutine nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US endif do m=1,CS%ntr - dt_x_rate = ( dt * CS%restore_rate(m) ) * US%T_to_s -!$OMP parallel do default(private) shared(CS,G,dt,dt_x_rate) + dt_x_rate = dt * CS%restore_rate(m) + !$OMP parallel do default(shared) private(target_value) do k=1,GV%ke ; do j=G%jsc,G%jec ; do i=G%isc,G%iec target_value = nw2_tracer_dist(m, G, GV, eta, i, j, k) CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + G%mask2dT(i,j) * dt_x_rate * ( target_value - CS%tr(i,j,k,m) ) @@ -270,13 +272,13 @@ real function nw2_tracer_dist(m, G, GV, eta, i, j, k) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),0:SZK_(G)), & - intent(in) :: eta !< Interface position [m] + intent(in) :: eta !< Interface position [Z ~> m] integer, intent(in) :: i !< Cell index i integer, intent(in) :: j !< Cell index j integer, intent(in) :: k !< Layer index k ! Local variables - real :: pi ! 3.1415... - real :: x, y, z ! non-dimensional positions + real :: pi ! 3.1415... [nondim] + real :: x, y, z ! non-dimensional relative positions [nondim] pi = 2.*acos(0.) x = ( G%geolonT(i,j) - G%west_lon ) / G%len_lon ! 0 ... 1 y = -G%geolatT(i,j) / G%south_lat ! -1 ... 1 diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 862209a688..6f690ab760 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -51,7 +51,6 @@ module oil_tracer real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this subroutine, in g m-3? real, dimension(NTR_MAX) :: IC_val = 0.0 !< The (uniform) initial condition value. real, dimension(NTR_MAX) :: land_val = -1.0 !< The value of tr used where land is masked out. - real, dimension(NTR_MAX) :: oil_decay_days !< Decay time scale of oil [days] real, dimension(NTR_MAX) :: oil_decay_rate !< Decay rate of oil [T-1 ~> s-1] calculated from oil_decay_days integer, dimension(NTR_MAX) :: oil_source_k !< Layer of source logical :: oil_may_reinit !< If true, oil tracers may be reset by the initialization code @@ -83,7 +82,8 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) ! Local variables character(len=40) :: mdl = "oil_tracer" ! This module's name. ! This include declares and sets the variable "version". -#include "version_variable.h" +# include "version_variable.h" + real, dimension(NTR_MAX) :: oil_decay_days !< Decay time scale of oil [days] character(len=200) :: inputdir ! The directory where the input files are. character(len=48) :: var_name ! The variable's name. character(len=3) :: name_tag ! String for creating identifying oils @@ -136,7 +136,7 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) call get_param(param_file, mdl, "OIL_SOURCE_RATE", CS%oil_source_rate, & "The rate of oil injection.", & units="kg s-1", scale=US%T_to_s, default=1.0) - call get_param(param_file, mdl, "OIL_DECAY_DAYS", CS%oil_decay_days, & + call get_param(param_file, mdl, "OIL_DECAY_DAYS", oil_decay_days, & "The decay timescale in days (if positive), or no decay "//& "if 0, or use the temperature dependent decay rate of "//& "Adcroft et al. (GRL, 2010) if negative.", units="days", & @@ -156,9 +156,9 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) CS%ntr = CS%ntr + 1 CS%tr_desc(m) = var_desc("oil"//trim(name_tag), "kg m-3", "Oil Tracer", caller=mdl) CS%IC_val(m) = 0.0 - if (CS%oil_decay_days(m)>0.) then - CS%oil_decay_rate(m) = 1. / (86400.0*US%s_to_T * CS%oil_decay_days(m)) - elseif (CS%oil_decay_days(m)<0.) then + if (oil_decay_days(m) > 0.) then + CS%oil_decay_rate(m) = 1. / (86400.0*US%s_to_T * oil_decay_days(m)) + elseif (oil_decay_days(m) < 0.) then CS%oil_decay_rate(m) = -1. endif endif @@ -326,9 +326,12 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] - real :: Isecs_per_year = 1.0 / (365.0*86400.0) + real :: Isecs_per_year = 1.0 / (365.0*86400.0) ! Conversion factor from seconds to year [year s-1] real :: vol_scale ! A conversion factor for volumes into m3 [m3 H-1 L-2 ~> 1 or m3 kg-1] - real :: year, h_total, ldecay + real :: year ! Time in fractional years [years] + real :: h_total ! A running sum of thicknesses [H ~> m or kg m-2] + real :: decay_timescale ! Chemical decay timescale for oil [T ~> s] + real :: ldecay ! Chemical decay rate of oil [T-1 ~> s-1] integer :: i, j, k, is, ie, js, je, nz, m, k_max is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -360,8 +363,8 @@ subroutine oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US if (CS%oil_decay_rate(m)>0.) then CS%tr(i,j,k,m) = G%mask2dT(i,j)*max(1. - dt*CS%oil_decay_rate(m),0.)*CS%tr(i,j,k,m) ! Safest elseif (CS%oil_decay_rate(m)<0.) then - ldecay = 12.*(3.0**(-(tv%T(i,j,k)-20.)/10.)) ! Timescale [days] - ldecay = 1. / (86400.*US%s_to_T * ldecay) ! Rate [T-1 ~> s-1] + decay_timescale = (12.*(3.0**(-(tv%T(i,j,k)-20.)/10.))) * (86400.*US%s_to_T) ! Timescale [s ~> T] + ldecay = 1. / decay_timescale ! Rate [T-1 ~> s-1] CS%tr(i,j,k,m) = G%mask2dT(i,j)*max(1. - dt*ldecay,0.)*CS%tr(i,j,k,m) endif enddo ; enddo ; enddo @@ -399,12 +402,13 @@ end subroutine oil_tracer_column_physics !> Calculate the mass-weighted integral of the oil tracer stocks, returning the number of stocks it !! has calculated. If the stock_index is present, only the stock corresponding to that coded index is returned. -function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) +function oil_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_oil_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. @@ -429,7 +433,7 @@ function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="oil_stock") units(m) = trim(units(m))//" kg" diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index 94ee126a59..c441e519be 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -253,12 +253,13 @@ end subroutine pseudo_salt_tracer_column_physics !> Calculates the mass-weighted integral of all tracer stocks, returning the number of stocks it has !! calculated. If the stock_index is present, only the stock corresponding to that coded index is returned. -function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) +function pseudo_salt_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_pseudo_salt_tracer character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated @@ -284,7 +285,7 @@ function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 call query_vardesc(CS%tr_desc, name=names(1), units=units(1), caller="pseudo_salt_stock") units(1) = trim(units(1))//" kg" stocks(1) = 0.0 diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 10551ea247..a41f0ab76d 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -358,13 +358,14 @@ end subroutine tracer_column_physics !> This function calculates the mass-weighted integral of all tracer stocks, !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function USER_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) +function USER_tracer_stock(h, stocks, G, GV, US, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(USER_tracer_example_CS), pointer :: CS !< The control structure returned by a !! previous call to register_USER_tracer. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. @@ -389,7 +390,7 @@ function USER_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) return endif ; endif - stock_scale = G%US%L_to_m**2 * GV%H_to_kg_m2 + stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,NTR call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="USER_tracer_stock") units(m) = trim(units(m))//" kg" diff --git a/src/user/dyed_channel_initialization.F90 b/src/user/dyed_channel_initialization.F90 index 317ed4ac21..ff98f16529 100644 --- a/src/user/dyed_channel_initialization.F90 +++ b/src/user/dyed_channel_initialization.F90 @@ -133,13 +133,14 @@ subroutine dyed_channel_set_OBC_tracer_data(OBC, G, GV, param_file, tr_Reg) end subroutine dyed_channel_set_OBC_tracer_data !> This subroutine updates the long-channel flow -subroutine dyed_channel_update_flow(OBC, CS, G, GV, Time) +subroutine dyed_channel_update_flow(OBC, CS, G, GV, US, Time) type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. type(dyed_channel_OBC_CS), pointer :: CS !< Dyed channel control structure. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(time_type), intent(in) :: Time !< model time. ! Local variables character(len=40) :: mdl = "dyed_channel_update_flow" ! This subroutine's name. @@ -154,7 +155,7 @@ subroutine dyed_channel_update_flow(OBC, CS, G, GV, Time) if (.not.associated(OBC)) call MOM_error(FATAL, 'dyed_channel_initialization.F90: '// & 'dyed_channel_update_flow() was called but OBC type was not initialized!') - time_sec = G%US%s_to_T * time_type_to_real(Time) + time_sec = US%s_to_T * time_type_to_real(Time) PI = 4.0*atan(1.0) do l=1, OBC%number_of_segments diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index 2c84a6040c..840f0bf3ed 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -158,7 +158,7 @@ subroutine shelfwave_set_OBC_data(OBC, CS, G, GV, US, h, Time) time_sec = US%s_to_T*time_type_to_real(Time) omega = CS%omega alpha = CS%alpha - my_amp = 1.0*G%US%m_s_to_L_T + my_amp = 1.0*US%m_s_to_L_T jj = CS%jj kk = CS%kk ll = CS%ll diff --git a/src/user/supercritical_initialization.F90 b/src/user/supercritical_initialization.F90 index 12a31f3a75..b4ceb1905d 100644 --- a/src/user/supercritical_initialization.F90 +++ b/src/user/supercritical_initialization.F90 @@ -8,8 +8,9 @@ module supercritical_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE, OBC_segment_type -use MOM_verticalGrid, only : verticalGrid_type use MOM_time_manager, only : time_type, time_type_to_real +use MOM_unit_scaling, only : unit_scale_type +use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -17,18 +18,16 @@ module supercritical_initialization public supercritical_set_OBC_data -! This include declares and sets the variable "version". -#include "version_variable.h" - contains !> This subroutine sets the properties of flow at open boundary conditions. -subroutine supercritical_set_OBC_data(OBC, G, GV, param_file) +subroutine supercritical_set_OBC_data(OBC, G, GV, US, param_file) type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file structure ! Local variables character(len=40) :: mdl = "supercritical_set_OBC_data" ! This subroutine's name. @@ -42,7 +41,7 @@ subroutine supercritical_set_OBC_data(OBC, G, GV, param_file) call get_param(param_file, mdl, "SUPERCRITICAL_ZONAL_FLOW", zonal_flow, & "Constant zonal flow imposed at upstream open boundary.", & - units="m/s", default=8.57, scale=G%US%m_s_to_L_T) + units="m/s", default=8.57, scale=US%m_s_to_L_T) do l=1, OBC%number_of_segments segment => OBC%segment(l) diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index 51772e2f9f..2438b4115a 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -51,13 +51,14 @@ function register_tidal_bay_OBC(param_file, CS, US, OBC_Reg) end function register_tidal_bay_OBC !> This subroutine sets the properties of flow at open boundary conditions. -subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, h, Time) +subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, US, h, Time) type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. type(tidal_bay_OBC_CS), intent(in) :: CS !< tidal bay control structure. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] type(time_type), intent(in) :: Time !< model time. @@ -84,7 +85,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, h, Time) allocate(my_area(1:1,js:je)) - flux_scale = GV%H_to_m*G%US%L_to_m + flux_scale = GV%H_to_m*US%L_to_m time_sec = time_type_to_real(Time) cff_eta = 0.1*GV%m_to_H * sin(2.0*PI*time_sec/(12.0*3600.0)) @@ -108,7 +109,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, GV, h, Time) if (.not. segment%on_pe) cycle - segment%normal_vel_bt(:,:) = my_flux / (G%US%m_to_Z*G%US%m_to_L*total_area) + segment%normal_vel_bt(:,:) = my_flux / (US%m_to_Z*US%m_to_L*total_area) segment%eta(:,:) = cff_eta enddo ! end segment loop From 9cb93044ef06a929171b5bd326a7c5c06aa72316 Mon Sep 17 00:00:00 2001 From: jiandewang Date: Mon, 20 Dec 2021 12:47:19 -0500 Subject: [PATCH 31/73] EMC stochastic candidate 20211028 (#1538) The stochastic physics feature has been added in MOM6. The following are from Phil Pegion: The ocean stochastic physics has been re-coded such that there is a wrapper in config_src/external/OCEAN_stochastic_phyiscs that contains the calls to the external stochastic_physics repository. This has been added to support non-UFS applications of MOM6 where the stochastic_physics repository is not part of the build. The init and run procedures are called from src/core/MOM.F90. I have also created a new control structure stochastic_CS, which contains the logical variables, and random patterns which are then passed into src/parameterizations/vertical/MOM_diabadic_driver.F90 and src/parameterizations/vertical/MOM_energetic-PBL.F90. The writing of the ocean stochastic restarts sit in config_src/nuopc_cap/mom_cap.F90 Co-authored-by: pjpegion --- config_src/drivers/nuopc_cap/mom_cap.F90 | 10 +- .../nuopc_cap/mom_ocean_model_nuopc.F90 | 26 +++- .../stochastic_physics/stochastic_physics.F90 | 68 +++++++++ src/core/MOM.F90 | 10 +- .../stochastic/MOM_stochastics.F90 | 144 ++++++++++++++++++ .../vertical/MOM_diabatic_driver.F90 | 70 ++++++++- .../vertical/MOM_energetic_PBL.F90 | 45 ++++-- 7 files changed, 350 insertions(+), 23 deletions(-) create mode 100644 config_src/external/stochastic_physics/stochastic_physics.F90 create mode 100644 src/parameterizations/stochastic/MOM_stochastics.F90 diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index ee498f4184..652f9e5b47 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -97,6 +97,7 @@ module MOM_cap_mod use NUOPC_Model, only: model_label_SetRunClock => label_SetRunClock use NUOPC_Model, only: model_label_Finalize => label_Finalize use NUOPC_Model, only: SetVM + !$use omp_lib , only : omp_set_num_threads implicit none; private @@ -1524,7 +1525,7 @@ subroutine ModelAdvance(gcomp, rc) integer :: nc type(ESMF_Time) :: MyTime integer :: seconds, day, year, month, hour, minute - character(ESMF_MAXSTR) :: restartname, cvalue + character(ESMF_MAXSTR) :: restartname, cvalue, stoch_restartname character(240) :: msgString character(ESMF_MAXSTR) :: casename integer :: iostat @@ -1738,14 +1739,19 @@ subroutine ModelAdvance(gcomp, rc) ! write the final restart without a timestamp if (ESMF_AlarmIsRinging(stop_alarm, rc=rc)) then write(restartname,'(A)')"MOM.res" + write(stoch_restartname,'(A)')"ocn_stoch.res.nc" else write(restartname,'(A,I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2)') & "MOM.res.", year, month, day, hour, minute, seconds + write(stoch_restartname,'(A,I4.4,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,"-",I2.2,A)') & + "ocn_stoch.res.", year, month, day, hour, minute, seconds,".nc" endif call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) ! write restart file(s) - call ocean_model_restart(ocean_state, restartname=restartname) + call ocean_model_restart(ocean_state, restartname=restartname, & + stoch_restartname=stoch_restartname) + endif if (is_root_pe()) then diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index aab909e56e..448f23140e 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -62,6 +62,7 @@ module MOM_ocean_model_nuopc use MOM_surface_forcing_nuopc, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum use MOM_surface_forcing_nuopc, only : ice_ocean_boundary_type, surface_forcing_CS use MOM_surface_forcing_nuopc, only : forcing_save_restart +use get_stochy_pattern_mod, only : write_stoch_restart_ocn use iso_fortran_env, only : int64 #include @@ -176,6 +177,10 @@ module MOM_ocean_model_nuopc !! steps can span multiple coupled time steps. logical :: diabatic_first !< If true, apply diabatic and thermodynamic !! processes before time stepping the dynamics. + logical :: do_sppt !< If true, stochastically perturb the diabatic and + !! write restarts + logical :: pert_epbl !< If true, then randomly perturb the KE dissipation and + !! genration termsand write restarts real :: eps_omesh !< Max allowable difference between ESMF mesh and MOM6 !! domain coordinates @@ -425,6 +430,17 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i endif call extract_surface_state(OS%MOM_CSp, OS%sfc_state) +! get number of processors and PE list for stocasthci physics initialization + call get_param(param_file, mdl, "DO_SPPT", OS%do_sppt, & + "If true, then stochastically perturb the thermodynamic "//& + "tendencies of T,S, and h. Amplitude and correlations are "//& + "controlled by the nam_stoch namelist in the UFS model only.", & + default=.false.) + call get_param(param_file, mdl, "PERT_EPBL", OS%pert_epbl, & + "If true, then stochastically perturb the kinetic energy "//& + "production and dissipation terms. Amplitude and correlations are "//& + "controlled by the nam_stoch namelist in the UFS model only.", & + default=.false.) call close_param_file(param_file) call diag_mediator_close_registration(OS%diag) @@ -686,7 +702,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & end subroutine update_ocean_model !> This subroutine writes out the ocean model restart file. -subroutine ocean_model_restart(OS, timestamp, restartname, num_rest_files) +subroutine ocean_model_restart(OS, timestamp, restartname, stoch_restartname, num_rest_files) type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the !! internal ocean state being saved to a restart file character(len=*), optional, intent(in) :: timestamp !< An optional timestamp string that should be @@ -694,6 +710,9 @@ subroutine ocean_model_restart(OS, timestamp, restartname, num_rest_files) character(len=*), optional, intent(in) :: restartname !< Name of restart file to use !! This option distinguishes the cesm interface from the !! non-cesm interface + character(len=*), optional, intent(in) :: stoch_restartname !< Name of restart file to use + !! This option distinguishes the cesm interface from the + !! non-cesm interface integer, optional, intent(out) :: num_rest_files !< number of restart files written if (.not.MOM_state_is_synchronized(OS%MOM_CSp)) & @@ -733,6 +752,11 @@ subroutine ocean_model_restart(OS, timestamp, restartname, num_rest_files) endif endif endif + if (present(stoch_restartname)) then + if (OS%do_sppt .OR. OS%pert_epbl) then + call write_stoch_restart_ocn('RESTART/'//trim(stoch_restartname)) + endif + endif end subroutine ocean_model_restart ! NAME="ocean_model_restart" diff --git a/config_src/external/stochastic_physics/stochastic_physics.F90 b/config_src/external/stochastic_physics/stochastic_physics.F90 new file mode 100644 index 0000000000..df62aa1591 --- /dev/null +++ b/config_src/external/stochastic_physics/stochastic_physics.F90 @@ -0,0 +1,68 @@ +! The are stubs for ocean stochastic physics +! the fully functional code is available at +! http://github.com/noaa-psd/stochastic_physics +module stochastic_physics + +implicit none + +private + +public :: init_stochastic_physics_ocn +public :: run_stochastic_physics_ocn + +contains + +!!!!!!!!!!!!!!!!!!!! +subroutine init_stochastic_physics_ocn(delt,geoLonT,geoLatT,nx,ny,nz,pert_epbl_in,do_sppt_in, & + mpiroot, mpicomm, iret) +implicit none +real,intent(in) :: delt !< timestep in seconds between calls to run_stochastic_physics_ocn +integer,intent(in) :: nx !< number of gridpoints in the x-direction of the compute grid +integer,intent(in) :: ny !< number of gridpoints in the y-direction of the compute grid +integer,intent(in) :: nz !< number of gridpoints in the z-direction of the compute grid +real,intent(in) :: geoLonT(nx,ny) !< Longitude in degrees +real,intent(in) :: geoLatT(nx,ny) !< Latitude in degrees +logical,intent(in) :: pert_epbl_in !< logical flag, if true generate random pattern for ePBL perturbations +logical,intent(in) :: do_sppt_in !< logical flag, if true generate random pattern for SPPT perturbations +integer,intent(in) :: mpiroot !< root processor +integer,intent(in) :: mpicomm !< mpi communicator +integer, intent(out) :: iret !< return code + +iret=0 +if (pert_epbl_in .EQV. .true. ) then + print*,'pert_epbl needs to be false if using the stub' + iret=-1 +endif +if (do_sppt_in.EQV. .true. ) then + print*,'do_sppt needs to be false if using the stub' + iret=-1 +endif +return +end subroutine init_stochastic_physics_ocn + +subroutine run_stochastic_physics_ocn(sppt_wts,t_rp1,t_rp2) +implicit none +real, intent(inout) :: sppt_wts(:,:) !< array containing random weights for SPPT range [0,2] +real, intent(inout) :: t_rp1(:,:) !< array containing random weights for ePBL + !! perturbations (KE generation) range [0,2] +real, intent(inout) :: t_rp2(:,:) !< array containing random weights for ePBL + !! perturbations (KE dissipation) range [0,2] +return +end subroutine run_stochastic_physics_ocn + +end module stochastic_physics + +module get_stochy_pattern_mod + +private + +public :: write_stoch_restart_ocn + +contains +subroutine write_stoch_restart_ocn(sfile) + +character(len=*) :: sfile !< name of restart file +return +end subroutine write_stoch_restart_ocn + +end module get_stochy_pattern_mod diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 1f1492f2e5..4072cf54a0 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -59,6 +59,7 @@ module MOM use MOM_coord_initialization, only : MOM_initialize_coord use MOM_diabatic_driver, only : diabatic, diabatic_driver_init, diabatic_CS, extract_diabatic_member use MOM_diabatic_driver, only : adiabatic, adiabatic_driver_init, diabatic_driver_end +use MOM_stochastics, only : stochastics_init, update_stochastics, stochastic_CS use MOM_diagnostics, only : calculate_diagnostic_fields, MOM_diagnostics_init use MOM_diagnostics, only : register_transport_diags, post_transport_diagnostics use MOM_diagnostics, only : register_surface_diags, write_static_fields @@ -396,6 +397,7 @@ module MOM type(ODA_CS), pointer :: odaCS => NULL() !< a pointer to the control structure for handling !! ensemble model state vectors and data assimilation !! increments and priors + type(stochastic_CS), pointer :: stoch_CS => NULL() !< a pointer to the stochastics control structure end type MOM_control_struct public initialize_MOM, finish_MOM_initialization, MOM_end @@ -640,6 +642,8 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS call disable_averaging(CS%diag) endif endif + ! advance the random pattern if stochastic physics is active + if (CS%stoch_CS%do_sppt .OR. CS%stoch_CS%pert_epbl) call update_stochastics(CS%stoch_CS) if (do_dyn) then if (G%nonblocking_updates) & @@ -790,6 +794,7 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS enddo ; enddo endif + call step_MOM_dynamics(forces, CS%p_surf_begin, CS%p_surf_end, dt, & dt_therm_here, bbl_time_int, CS, & Time_local, Waves=Waves) @@ -1342,7 +1347,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call cpu_clock_begin(id_clock_diabatic) call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, dtdia, & - Time_end_thermo, G, GV, US, CS%diabatic_CSp, OBC=CS%OBC, Waves=Waves) + Time_end_thermo, G, GV, US, CS%diabatic_CSp, CS%stoch_CS,OBC=CS%OBC, Waves=Waves) fluxes%fluxes_used = .true. if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") @@ -2834,6 +2839,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call init_oda(Time, G, GV, CS%diag, CS%odaCS) endif + ! initialize stochastic physics + call stochastics_init(CS%dt_therm, CS%G, CS%GV, CS%stoch_CS, param_file, diag, Time) + !### This could perhaps go here instead of in finish_MOM_initialization? ! call fix_restart_scaling(GV) ! call fix_restart_unit_scaling(US) diff --git a/src/parameterizations/stochastic/MOM_stochastics.F90 b/src/parameterizations/stochastic/MOM_stochastics.F90 new file mode 100644 index 0000000000..21a22a222e --- /dev/null +++ b/src/parameterizations/stochastic/MOM_stochastics.F90 @@ -0,0 +1,144 @@ +!> Top-level module for the MOM6 ocean model in coupled mode. +module MOM_stochastics + +! This file is part of MOM6. See LICENSE.md for the license. + +! This is the top level module for the MOM6 ocean model. It contains routines +! for initialization, update, and writing restart of stochastic physics. This +! particular version wraps all of the calls for MOM6 in the calls that had +! been used for MOM4. +! +use MOM_diag_mediator, only : register_diag_field, diag_ctrl, time_type +use MOM_grid, only : ocean_grid_type +use MOM_verticalGrid, only : verticalGrid_type +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_error_handler, only : callTree_enter, callTree_leave +use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type +use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain +use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain +use MOM_domains, only : root_PE,num_PEs +use MOM_coms, only : Get_PElist +use stochastic_physics, only : init_stochastic_physics_ocn, run_stochastic_physics_ocn + +#include + +implicit none ; private + +public stochastics_init, update_stochastics + +!> This control structure holds parameters for the MOM_stochastics module +type, public:: stochastic_CS + logical :: do_sppt !< If true, stochastically perturb the diabatic + logical :: pert_epbl !< If true, then randomly perturb the KE dissipation and genration terms + integer :: id_sppt_wts = -1 !< Diagnostic id for SPPT + integer :: id_epbl1_wts=-1 !< Diagnostic id for epbl generation perturbation + integer :: id_epbl2_wts=-1 !< Diagnostic id for epbl dissipation perturbation + ! stochastic patterns + real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT + !! tendencies with a number between 0 and 2 + real, allocatable :: epbl1_wts(:,:) !< Random pattern for K.E. generation + real, allocatable :: epbl2_wts(:,:) !< Random pattern for K.E. dissipation + type(diag_ctrl), pointer :: diag !< structure used to regulate timing of diagnostic output + type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) +end type stochastic_CS + +contains + +!! This subroutine initializes the stochastics physics control structure. +subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) + real, intent(in) :: dt !< time step [T ~> s] + type(ocean_grid_type), intent(in) :: grid !< horizontal grid information + type(verticalGrid_type), intent(in) :: GV !< vertical grid structure + type(stochastic_CS), pointer, intent(inout):: CS !< stochastic control structure + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(diag_ctrl), target, intent(inout) :: diag !< structure to regulate diagnostic output + type(time_type), target :: Time !< model time + ! Local variables + integer,allocatable :: pelist(:) ! list of pes for this instance of the ocean + integer :: mom_comm ! list of pes for this instance of the ocean + integer :: num_procs ! number of processors to pass to stochastic physics + integer :: iret ! return code from stochastic physics + integer :: me ! my pe + integer :: pe_zero ! root pe + integer :: nx ! number of x-points including halo + integer :: ny ! number of x-points including halo + +! This include declares and sets the variable "version". +#include "version_variable.h" + character(len=40) :: mdl = "ocean_stochastics_init" ! This module's name. + + call callTree_enter("ocean_model_stochastic_init(), MOM_stochastics.F90") + if (associated(CS)) then + call MOM_error(WARNING, "MOM_stochastics_init called with an "// & + "associated control structure.") + return + else ; allocate(CS) ; endif + + CS%diag => diag + CS%Time => Time + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mdl, version, "") + +! get number of processors and PE list for stocasthci physics initialization + call get_param(param_file, mdl, "DO_SPPT", CS%do_sppt, & + "If true, then stochastically perturb the thermodynamic "//& + "tendemcies of T,S, amd h. Amplitude and correlations are "//& + "controlled by the nam_stoch namelist in the UFS model only.", & + default=.false.) + call get_param(param_file, mdl, "PERT_EPBL", CS%pert_epbl, & + "If true, then stochastically perturb the kinetic energy "//& + "production and dissipation terms. Amplitude and correlations are "//& + "controlled by the nam_stoch namelist in the UFS model only.", & + default=.false.) + if (CS%do_sppt .OR. CS%pert_epbl) then + num_procs=num_PEs() + allocate(pelist(num_procs)) + call Get_PElist(pelist,commID = mom_comm) + pe_zero=root_PE() + nx = grid%ied - grid%isd + 1 + ny = grid%jed - grid%jsd + 1 + call init_stochastic_physics_ocn(dt,grid%geoLonT,grid%geoLatT,nx,ny,GV%ke, & + CS%pert_epbl,CS%do_sppt,pe_zero,mom_comm,iret) + if (iret/=0) then + call MOM_error(FATAL, "call to init_stochastic_physics_ocn failed") + return + endif + + if (CS%do_sppt) allocate(CS%sppt_wts(grid%isd:grid%ied,grid%jsd:grid%jed)) + if (CS%pert_epbl) then + allocate(CS%epbl1_wts(grid%isd:grid%ied,grid%jsd:grid%jed)) + allocate(CS%epbl2_wts(grid%isd:grid%ied,grid%jsd:grid%jed)) + endif + endif + CS%id_sppt_wts = register_diag_field('ocean_model', 'sppt_pattern', CS%diag%axesT1, Time, & + 'random pattern for sppt', 'None') + CS%id_epbl1_wts = register_diag_field('ocean_model', 'epbl1_wts', CS%diag%axesT1, Time, & + 'random pattern for KE generation', 'None') + CS%id_epbl2_wts = register_diag_field('ocean_model', 'epbl2_wts', CS%diag%axesT1, Time, & + 'random pattern for KE dissipation', 'None') + + if (is_root_pe()) & + write(*,'(/12x,a/)') '=== COMPLETED MOM STOCHASTIC INITIALIZATION =====' + + call callTree_leave("ocean_model_init(") + return +end subroutine stochastics_init + +!> update_ocean_model uses the forcing in Ice_ocean_boundary to advance the +!! ocean model's state from the input value of Ocean_state (which must be for +!! time time_start_update) for a time interval of Ocean_coupling_time_step, +!! returning the publicly visible ocean surface properties in Ocean_sfc and +!! storing the new ocean properties in Ocean_state. +subroutine update_stochastics(CS) + type(stochastic_CS), intent(inout) :: CS !< diabatic control structure + call callTree_enter("update_stochastics(), MOM_stochastics.F90") + +! update stochastic physics patterns before running next time-step + call run_stochastic_physics_ocn(CS%sppt_wts,CS%epbl1_wts,CS%epbl2_wts) + + return +end subroutine update_stochastics + +end module MOM_stochastics + diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index a546bcdec0..c9df559583 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -68,6 +68,7 @@ module MOM_diabatic_driver use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_wave_speed, only : wave_speeds use MOM_wave_interface, only : wave_parameters_CS +use MOM_stochastics, only : stochastic_CS implicit none ; private @@ -263,7 +264,7 @@ module MOM_diabatic_driver !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, OBC, Waves) + G, GV, US, CS, stoch_CS, OBC, Waves) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< zonal velocity [L T-1 ~> m s-1] @@ -283,6 +284,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(diabatic_CS), pointer :: CS !< module control structure + type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves @@ -295,6 +297,28 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & integer :: i, j, k, m, is, ie, js, je, nz logical :: showCallTree ! If true, show the call tree + real, allocatable, dimension(:,:,:) :: h_in ! thickness before thermodynamics + real, allocatable, dimension(:,:,:) :: t_in ! temperature before thermodynamics + real, allocatable, dimension(:,:,:) :: s_in ! salinity before thermodynamics + real :: t_tend,s_tend,h_tend ! holder for tendencey needed for SPPT + real :: t_pert,s_pert,h_pert ! holder for perturbations needed for SPPT + + if (G%ke == 1) return + + ! save copy of the date for SPPT if active + if (stoch_CS%do_sppt) then + allocate(h_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) + allocate(t_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) + allocate(s_in(G%isd:G%ied, G%jsd:G%jed,G%ke)) + h_in(:,:,:)=h(:,:,:) + t_in(:,:,:)=tv%T(:,:,:) + s_in(:,:,:)=tv%S(:,:,:) + + if (stoch_CS%id_sppt_wts > 0) then + call post_data(stoch_CS%id_sppt_wts, stoch_CS%sppt_wts, CS%diag) + endif + endif + if (GV%ke == 1) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -378,10 +402,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves) + G, GV, US, CS, stoch_CS, Waves) elseif (CS%useALEalgorithm) then call diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves) + G, GV, US, CS, stoch_CS, Waves) else call layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) @@ -447,13 +471,41 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G, GV, US) + if (stoch_CS%do_sppt) then + ! perturb diabatic tendecies + do k=1,nz + do j=js,je + do i=is,ie + h_tend = (h(i,j,k)-h_in(i,j,k))*stoch_CS%sppt_wts(i,j) + t_tend = (tv%T(i,j,k)-t_in(i,j,k))*stoch_CS%sppt_wts(i,j) + s_tend = (tv%S(i,j,k)-s_in(i,j,k))*stoch_CS%sppt_wts(i,j) + h_pert=h_tend+h_in(i,j,k) + t_pert=t_tend+t_in(i,j,k) + s_pert=s_tend+s_in(i,j,k) + if (h_pert > GV%Angstrom_H) then + h(i,j,k) = h_pert + else + h(i,j,k) = GV%Angstrom_H + endif + tv%T(i,j,k) = t_pert + if (s_pert > 0.0) then + tv%S(i,j,k) = s_pert + endif + enddo + enddo + enddo + deallocate(h_in) + deallocate(t_in) + deallocate(s_in) + endif + end subroutine diabatic !> Applies diabatic forcing and diapycnal mixing of temperature, salinity and other tracers for use !! with an ALE algorithm. This version uses an older set of algorithms compared with diabatic_ALE. subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves) + G, GV, US, CS, stoch_CS, Waves) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -473,6 +525,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim real, intent(in) :: dt !< time increment [T ~> s] type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure + type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves ! local variables @@ -774,7 +827,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + CS%energetic_PBL_CSp, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & + waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) @@ -1037,7 +1091,7 @@ end subroutine diabatic_ALE_legacy !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, Waves) + G, GV, US, CS, stoch_CS, Waves) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1057,6 +1111,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, real, intent(in) :: dt !< time increment [T ~> s] type(time_type), intent(in) :: Time_end !< Time at the end of the interval type(diabatic_CS), pointer :: CS !< module control structure + type(stochastic_CS), pointer :: stoch_CS !< stochastic control structure type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves ! local variables @@ -1309,7 +1364,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + CS%energetic_PBL_CSp, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, & + waves=waves) if (associated(Hml)) then call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 5a9e67bfd9..351f55984f 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -17,6 +17,7 @@ module MOM_energetic_PBL use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only: wave_parameters_CS, Get_Langmuir_Number +use MOM_stochastics, only : stochastic_CS implicit none ; private @@ -168,7 +169,6 @@ module MOM_energetic_PBL real, allocatable, dimension(:,:) :: & ML_depth !< The mixed layer depth determined by active mixing in ePBL [Z ~> m]. - ! These are terms in the mixed layer TKE budget, all in [R Z3 T-3 ~> W m-2 = kg s-3]. real, allocatable, dimension(:,:) :: & diag_TKE_wind, & !< The wind source of TKE [R Z3 T-3 ~> W m-2]. @@ -245,9 +245,9 @@ module MOM_energetic_PBL !! mixed layer model. It assumes that heating, cooling and freshwater fluxes !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. -subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & - dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, last_call, & - dT_expected, dS_expected, Waves ) +subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & + stoch_CS, dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, & + last_call, dT_expected, dS_expected, Waves) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -300,6 +300,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS !! diffusivities are applied [ppt]. type(wave_parameters_CS), & optional, pointer :: Waves !< Wave CS + type(stochastic_CS), pointer :: stoch_CS !< The control structure returned by a previous ! This subroutine determines the diffusivities from the integrated energetics ! mixed layer model. It assumes that heating, cooling and freshwater fluxes @@ -456,11 +457,17 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Perhaps provide a first guess for MLD based on a stored previous value. MLD_io = -1.0 if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) - - call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & - u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & - US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) - + if (stoch_CS%pert_epbl) then ! stochastics are active + call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & + u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & + US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, & + epbl1_wt=stoch_CS%epbl1_wts(i,j),epbl2_wt=stoch_CS%epbl2_wts(i,j), & + i=i, j=j) + else + call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & + u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & + US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) + endif ! Copy the diffusivities to a 2-d array. do K=1,nz+1 @@ -531,6 +538,12 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS if (CS%id_LA > 0) call post_data(CS%id_LA, CS%LA, CS%diag) if (CS%id_LA_MOD > 0) call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) + ! only write random patterns if running with stochastic physics, otherwise the + ! array is unallocated and will give an error + if (stoch_CS%pert_epbl) then + if (stoch_CS%id_epbl1_wts > 0) call post_data(stoch_CS%id_epbl1_wts, stoch_CS%epbl1_wts, CS%diag) + if (stoch_CS%id_epbl2_wts > 0) call post_data(stoch_CS%id_epbl2_wts, stoch_CS%epbl2_wts, CS%diag) + endif endif if (debug) deallocate(eCD%dT_expect, eCD%dS_expect) @@ -543,7 +556,7 @@ end subroutine energetic_PBL !! mixed layer model for a single column of water. subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, & - dt_diag, Waves, G, i, j) + dt_diag, Waves, G, epbl1_wt, epbl2_wt, i, j) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. @@ -587,6 +600,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs optional, pointer :: Waves !< Wave CS for Langmuir turbulence type(ocean_grid_type), & optional, intent(inout) :: G !< The ocean's grid structure. + real, optional, intent(in) :: epbl1_wt !< random number to perturb KE generation + real, optional, intent(in) :: epbl2_wt !< random number to perturb KE dissipation integer, optional, intent(in) :: i !< The i-index to work on (used for Waves) integer, optional, intent(in) :: j !< The i-index to work on (used for Waves) @@ -881,6 +896,8 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs else mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) endif + ! stochastically pertrub mech_TKE in the UFS + if (present(epbl1_wt)) mech_TKE=mech_TKE*epbl1_wt if (CS%TKE_diagnostics) then eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 @@ -963,7 +980,12 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag - mech_TKE = mech_TKE * exp_kh + if (present(epbl2_wt)) then ! perturb the TKE destruction + mech_TKE = mech_TKE * (1+(exp_kh-1) * epbl2_wt) + else + mech_TKE = mech_TKE * exp_kh + endif + !if ( i .eq. 10 .and. j .eq. 10 .and. k .eq. nz) print*,'mech TKE', mech_TKE ! Accumulate any convectively released potential energy to contribute ! to wstar and to drive penetrating convection. @@ -2373,7 +2395,6 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) Time, 'Velocity Scale that is used.', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & Time, 'Total mstar that is used.', 'nondim') - if (CS%use_LT) then CS%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, & Time, 'Langmuir number.', 'nondim') From 986bc8c0b9391222fe84c95c1db3fe8d1743d342 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 13 Dec 2021 20:19:21 -0500 Subject: [PATCH 32/73] Corrected the unit documentation for 31 variables Corrected the documentation of the units for 31 variables in various modules. All answers and output are bitwise identical. --- src/core/MOM_PressureForce_FV.F90 | 3 ++- src/core/MOM_continuity_PPM.F90 | 4 ++-- src/core/MOM_dynamics_split_RK2.F90 | 4 ++-- src/diagnostics/MOM_wave_structure.F90 | 16 ++++++++-------- src/initialization/MOM_shared_initialization.F90 | 2 +- .../vertical/MOM_bulk_mixed_layer.F90 | 4 ++-- .../vertical/MOM_diabatic_aux.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 4 ++-- src/tracer/MOM_lateral_boundary_diffusion.F90 | 2 +- src/tracer/MOM_tracer_registry.F90 | 3 ++- src/user/Idealized_Hurricane.F90 | 2 +- src/user/MOM_controlled_forcing.F90 | 5 +++-- src/user/SCM_CVMix_tests.F90 | 6 +++--- src/user/baroclinic_zone_initialization.F90 | 2 +- 14 files changed, 31 insertions(+), 28 deletions(-) diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 5ead019717..1666b4a97e 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -153,7 +153,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ ! [H T2 R-1 L-2 ~> m Pa-1 or kg m-2 Pa-1]. real :: H_to_RL2_T2 ! A factor to convert from thickness units (H) to pressure ! units [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1]. -! real :: oneatm = 101325.0 ! 1 atm in [Pa] = [kg m-1 s-2] +! real :: oneatm ! 1 standard atmosphere of pressure in [R L2 T-2 ~> Pa] real, parameter :: C1_6 = 1.0/6.0 integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state @@ -187,6 +187,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ p(i,j,1) = p_atm(i,j) enddo ; enddo else + ! oneatm = 101325.0 * US%kg_m3_to_R * US%m_s_to_L_T**2 ! 1 atm scaled to [R L2 T-2 ~> Pa] !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 p(i,j,1) = 0.0 ! or oneatm diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 17d2f830c0..7bc67e2fdf 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -924,8 +924,8 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, FAmt_0, & ! test velocities [H L ~> m2 or kg m-1]. uhtot_L, & ! The summed transport with the westerly (uhtot_L) and uhtot_R ! and easterly (uhtot_R) test velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. - real :: FA_0 ! The effective face area with 0 barotropic transport [L H ~> m2 or kg m]. - real :: FA_avg ! The average effective face area [L H ~> m2 or kg m], nominally given by + real :: FA_0 ! The effective face area with 0 barotropic transport [L H ~> m2 or kg m-1]. + real :: FA_avg ! The average effective face area [L H ~> m2 or kg m-1], nominally given by ! the realized transport divided by the barotropic velocity. real :: visc_rem_lim ! The larger of visc_rem and min_visc_rem [nondim]. This ! limiting is necessary to keep the inverse of visc_rem diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index a762da7f33..f1a2b2469d 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -337,8 +337,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s real, pointer, dimension(:,:,:) :: & ! These pointers are used to alter which fields are passed to btstep with various options: - u_ptr => NULL(), & ! A pointer to a zonal velocity [L T-1] - v_ptr => NULL(), & ! A pointer to a meridional velocity [L T-1] + u_ptr => NULL(), & ! A pointer to a zonal velocity [L T-1 ~> m s-1] + v_ptr => NULL(), & ! A pointer to a meridional velocity [L T-1 ~> m s-1] uh_ptr => NULL(), & ! A pointer to a zonal volume or mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] vh_ptr => NULL(), & ! A pointer to a meridional volume or mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] ! These pointers are just used as shorthand for CS%u_av, CS%v_av, and CS%h_av. diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index 2dd272d409..c833e973c5 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -171,11 +171,11 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real, dimension(SZK_(GV)) :: dz !< thicknesses of merged layers (same as Hc I hope) [Z ~> m] ! real, dimension(SZK_(GV)+1) :: dWdz_profile !< profile of dW/dz real :: w2avg !< average of squared vertical velocity structure funtion [Z ~> m] - real :: int_dwdz2 - real :: int_w2 - real :: int_N2w2 - real :: KE_term !< terms in vertically averaged energy equation - real :: PE_term !< terms in vertically averaged energy equation + real :: int_dwdz2 !< Vertical integral of the square of u_strct [Z ~> m] + real :: int_w2 !< Vertical integral of the square of w_strct [Z ~> m] + real :: int_N2w2 !< Vertical integral of N2 [Z T-2 ~> m s-2] + real :: KE_term !< terms in vertically averaged energy equation [R Z ~> kg m-2] + real :: PE_term !< terms in vertically averaged energy equation [R Z ~> kg m-2] real :: W0 !< A vertical velocity magnitude [Z T-1 ~> m s-1] real :: gp_unscaled !< A version of gprime rescaled to [L T-2 ~> m s-2]. real, dimension(SZK_(GV)-1) :: lam_z !< product of eigen value and gprime(k); one value for each @@ -183,8 +183,8 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo real, dimension(SZK_(GV)-1) :: a_diag, b_diag, c_diag !< diagonals of tridiagonal matrix; one value for each !< interface (excluding surface and bottom) - real, dimension(SZK_(GV)-1) :: e_guess !< guess at eigen vector with unit amplitde (for TDMA) - real, dimension(SZK_(GV)-1) :: e_itt !< improved guess at eigen vector (from TDMA) + real, dimension(SZK_(GV)-1) :: e_guess !< guess at eigen vector with unit amplitude (for TDMA) [nondim] + real, dimension(SZK_(GV)-1) :: e_itt !< improved guess at eigen vector (from TDMA) [nondim] real :: Pi integer :: kc integer :: i, j, k, k2, itt, is, ie, js, je, nz, nzm, row, ig, jg, ig_stop, jg_stop @@ -523,7 +523,7 @@ subroutine wave_structure(h, tv, G, GV, US, cn, ModeNum, freq, CS, En, full_halo ! Back-calculate amplitude from energy equation if (present(En) .and. (freq**2*Kmag2 > 0.0)) then - ! Units here are [R + ! Units here are [R Z ~> kg m-2] KE_term = 0.25*GV%Rho0*( ((freq**2 + f2) / (freq**2*Kmag2))*int_dwdz2 + int_w2 ) PE_term = 0.25*GV%Rho0*( int_N2w2 / freq**2 ) if (En(i,j) >= 0.0) then diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index bb5a84033b..fc5ceaf3e4 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -814,7 +814,7 @@ subroutine reset_face_lengths_list(G, param_file, US) real, allocatable, dimension(:) :: & Dmin_u, Dmax_u, Davg_u ! Porous barrier monomial fit params [m] real, allocatable, dimension(:) :: & - Dmin_v, Dmax_v, Davg_v + Dmin_v, Dmax_v, Davg_v ! Porous barrier monomial fit params [m] real :: lat, lon ! The latitude and longitude of a point. real :: len_lon ! The periodic range of longitudes, usually 360 degrees. real :: len_lat ! The range of latitudes, usually 180 degrees. diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 046329523d..dd160c300c 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -489,7 +489,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! netMassInOut = water [H ~> m or kg m-2] added/removed via surface fluxes ! netMassOut = water [H ~> m or kg m-2] removed via evaporating surface fluxes ! net_heat = heat via surface fluxes [degC H ~> degC m or degC kg m-2] - ! net_salt = salt via surface fluxes [ppt H ~> dppt m or gSalt m-2] + ! net_salt = salt via surface fluxes [ppt H ~> ppt m or gSalt m-2] ! Pen_SW_bnd = components to penetrative shortwave radiation call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & CS%H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & @@ -1527,7 +1527,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: TKE_full_ent ! The TKE remaining if a layer is fully entrained ! [Z L2 T-2 ~> m3 s-2]. real :: dRL ! Work required to mix water from the next layer - ! across the mixed layer [L2 T-2 ~> L2 s-2]. + ! across the mixed layer [L2 T-2 ~> m2 s-2]. real :: Pen_En_Contrib ! Penetrating SW contributions to the changes in ! TKE, divided by layer thickness in m [L2 T-2 ~> m2 s-2]. real :: Cpen1 ! A temporary variable [L2 T-2 ~> m2 s-2]. diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 312d114dde..c421b3a0f7 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1171,7 +1171,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! netMassOut < 0 means mass leaves ocean. ! netHeat = heat via surface fluxes [degC H ~> degC m or degC kg m-2], excluding the part ! contained in Pen_SW_bnd; and excluding heat_content of netMassOut < 0. - ! netSalt = surface salt fluxes [ppt H ~> dppt m or gSalt m-2] + ! netSalt = surface salt fluxes [ppt H ~> ppt m or gSalt m-2] ! Pen_SW_bnd = components to penetrative shortwave radiation split according to bands. ! This field provides that portion of SW from atmosphere that in fact ! enters to the ocean and participates in pentrative SW heating. diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 861a8957c1..f7d4b0cc0d 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -200,7 +200,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. real :: hutot ! Running sum of thicknesses times the - ! velocity magnitudes [H T T-1 ~> m2 s-1 or kg m-1 s-1]. + ! velocity magnitudes [H L T-1 ~> m2 s-1 or kg m-1 s-1]. real :: Thtot ! Running sum of thickness times temperature [degC H ~> degC m or degC kg m-2]. real :: Shtot ! Running sum of thickness times salinity [ppt H ~> ppt m or ppt kg m-2]. real :: hweight ! The thickness of a layer that is within Hbbl @@ -597,7 +597,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) ! When stratification dominates h_N< kg m-2 or kg m-5] + ustarsq = Rho0x400_G * ustar(i)**2 ! Note not in units of u*^2 but [H R ~> kg m-2 or kg2 m-5] htot = 0.0 ! Calculate the thickness of a stratification limited BBL ignoring rotation: diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index 19d40f2db1..c11bc9856c 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -596,7 +596,7 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ real, allocatable :: F_layer_z(:) !< Diffusive flux at U/V-point in the ztop grid [H L2 conc ~> m3 conc] real :: h_vel(ke) !< Thicknesses at u- and v-points in the native grid !! The harmonic mean is used to avoid zero values [H ~> m or kg m-2] - real :: khtr_avg !< Thickness-weighted diffusivity at the velocity-point [L2 T-1 ~> m s-1] + real :: khtr_avg !< Thickness-weighted diffusivity at the velocity-point [L2 T-1 ~> m2 s-1] !! This is just to remind developers that khtr_avg should be !! computed once khtr is 3D. real :: htot !< Total column thickness [H ~> m or kg m-2] diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index c729231927..2c77df3e74 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -84,7 +84,8 @@ module MOM_tracer_registry ! real, dimension(:,:,:), pointer :: diff_cont_xy => NULL() !< convergence of lateral diffusive tracer fluxes ! !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] ! real, dimension(:,:,:), pointer :: diff_conc_xy => NULL() !< convergence of lateral diffusive tracer fluxes -! !! expressed as a change in concentration [conc T-1] +! !! expressed as a change in concentration +! !! [conc T-1 ~> conc s-1] real, dimension(:,:,:), pointer :: t_prev => NULL() !< tracer concentration array at a previous !! timestep used for diagnostics [conc] real, dimension(:,:,:), pointer :: Trxh_prev => NULL() !< layer integrated tracer concentration array diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index 7182fc364a..707a0972f9 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -595,7 +595,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C U_TS = CS%hurr_translation_spd*0.5*cos(transdir) V_TS = CS%hurr_translation_spd*0.5*sin(transdir) - ! Set the surface wind stresses, in [Pa]. A positive taux + ! Set the surface wind stresses, in [R L Z T-2 ~> Pa]. A positive taux ! accelerates the ocean to the (pseudo-)east. ! The i-loop extends to is-1 so that taux can be used later in the ! calculation of ustar - otherwise the lower bound would be Isq. diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index f783a271a6..d136d58a19 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -46,7 +46,7 @@ module MOM_controlled_forcing real :: lam_prec !< A constant of proportionality between SSS anomalies !! (normalised by mean SSS) and precipitation [R Z T-1 ~> kg m-2 s-1] real :: lam_cyc_heat !< A constant of proportionality between cyclical SST - !! anomalies and corrective heat fluxes [W m-2 degC-1] + !! anomalies and corrective heat fluxes [Q R Z T-1 degC-1 ~> W m-2 degC-1] real :: lam_cyc_prec !< A constant of proportionality between cyclical SSS !! anomalies (normalised by mean SSS) and corrective !! precipitation [R Z T-1 ~> kg m-2 s-1] @@ -270,7 +270,8 @@ subroutine apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, virt_heat, virt_prec ! Accumulate the average anomalies for this period. dt_wt = wt_per1 * dt CS%avg_time(m_mid) = CS%avg_time(m_mid) + dt_wt - ! These loops temporarily change the units of the CS%avg_ variables to [degC s] or [ppt s]. + ! These loops temporarily change the units of the CS%avg_ variables to [degC T ~> degC s] + ! or [ppt T ~> ppt s]. do j=js,je ; do i=is,ie CS%avg_SST_anom(i,j,m_mid) = CS%avg_SST_anom(i,j,m_mid) + & dt_wt * G%mask2dT(i,j) * SST_anom(i,j) diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index 1fbc7a2b62..5bbe65b8d8 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -36,8 +36,8 @@ module SCM_CVMix_tests logical :: UseHeatFlux !< True to use heat flux logical :: UseEvaporation !< True to use evaporation logical :: UseDiurnalSW !< True to use diurnal sw radiation - real :: tau_x !< (Constant) Wind stress, X [Pa] - real :: tau_y !< (Constant) Wind stress, Y [Pa] + real :: tau_x !< (Constant) Wind stress, X [R L Z T-2 ~> Pa] + real :: tau_y !< (Constant) Wind stress, Y [R L Z T-2 ~> Pa] real :: surf_HF !< (Constant) Heat flux [degC Z T-1 ~> m degC s-1] real :: surf_evap !< (Constant) Evaporation rate [Z T-1 ~> m s-1] real :: Max_sw !< maximum of diurnal sw radiation [degC Z T-1 ~> degC m s-1] @@ -56,7 +56,7 @@ subroutine SCM_CVMix_tests_TS_init(T, S, h, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [degC] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [psu] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Input parameter structure diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index 1555f4ecad..a214012541 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -36,7 +36,7 @@ subroutine bcz_params(G, GV, US, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, real, intent(out) :: S_ref !< Reference salinity [ppt] real, intent(out) :: dSdz !< Salinity stratification [ppt Z-1 ~> ppt m-1] real, intent(out) :: delta_S !< Salinity difference across baroclinic zone [ppt] - real, intent(out) :: dSdx !< Linear salinity gradient [ppt m-1] + real, intent(out) :: dSdx !< Linear salinity gradient [ppt G%xaxis_units-1] real, intent(out) :: T_ref !< Reference temperature [degC] real, intent(out) :: dTdz !< Temperature stratification [degC Z-1 ~> degC m-1] real, intent(out) :: delta_T !< Temperature difference across baroclinic zone [degC] From d2442461abdaf32cb9d737d3e798fcdea597b239 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 14 Dec 2021 13:25:16 -0500 Subject: [PATCH 33/73] +Rescale tides and ramp-up times Rescaled the dimensions of the tidal amplitudes and frequencies used internally in calc_tidal_forcing() and ramp-up times used by update_OBC_ramp() and updateCFLtruncationValue() for nearly complete dimensional consistency testing. New unit_scale_type arguments were added to 5 routines, in the case of calc_tidal_forcing() replacing a previous optional argument that was always being used. One overly short internal variable, "N", was renamed "nodelon" to make its purpose clearer and easier to search for. All answers are bitwise identical, but there are changes to the argument lists of 5 routines. --- src/core/MOM_PressureForce_FV.F90 | 4 +- src/core/MOM_PressureForce_Montgomery.F90 | 4 +- src/core/MOM_dynamics_split_RK2.F90 | 10 +- src/core/MOM_dynamics_unsplit.F90 | 2 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 2 +- src/core/MOM_open_boundary.F90 | 25 +-- .../lateral/MOM_tidal_forcing.F90 | 158 ++++++++++-------- .../vertical/MOM_vert_friction.F90 | 34 ++-- 8 files changed, 127 insertions(+), 112 deletions(-) diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 1666b4a97e..30b2e90d1a 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -306,7 +306,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 SSH(i,j) = (za(i,j) - alpha_ref*p(i,j,1)) * I_gEarth - G%Z_ref enddo ; enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, US, CS%tides_CSp) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 za(i,j) = za(i,j) - GV%g_Earth * e_tidal(i,j) @@ -574,7 +574,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm SSH(i,j) = SSH(i,j) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, US, CS%tides_CSp) endif ! Here layer interface heights, e, are calculated. diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index a827fb12d0..18ea07b313 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -203,7 +203,7 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb enddo ; enddo ; enddo endif - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, US, CS%tides_CSp) !$OMP parallel do default(shared) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 geopot_bot(i,j) = -GV%g_Earth*(e_tidal(i,j) + G%bathyT(i,j)) @@ -451,7 +451,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, SSH(i,j) = SSH(i,j) + h(i,j,k)*GV%H_to_Z enddo ; enddo enddo - call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, CS%tides_CSp, m_to_Z=US%m_to_Z) + call calc_tidal_forcing(CS%Time, SSH, e_tidal, G, US, CS%tides_CSp) endif ! Here layer interface heights, e, are calculated. diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index f1a2b2469d..68b844562f 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -374,7 +374,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s enddo ! Update CFL truncation value as function of time - call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp) + call updateCFLtruncationValue(Time_local, CS%vertvisc_CSp, US) if (CS%debug) then call MOM_state_chksum("Start predictor ", u, v, h, uh, vh, G, GV, US, symmetric=sym) @@ -395,7 +395,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (CS%debug_OBC) call open_boundary_test_extern_h(G, GV, CS%OBC, h) ! Update OBC ramp value as function of time - call update_OBC_ramp(Time_local, CS%OBC) + call update_OBC_ramp(Time_local, CS%OBC, US) do k=1,nz ; do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB u_old_rad_OBC(I,j,k) = u_av(I,j,k) @@ -1207,20 +1207,20 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) cont_stencil = continuity_stencil(CS%continuity_CSp) call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv) - if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) + if (use_tides) call tidal_forcing_init(Time, G, US, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc, ADp=CS%ADp) call vertvisc_init(MIS, Time, G, GV, US, param_file, diag, CS%ADp, dirs, & ntrunc, CS%vertvisc_CSp) CS%set_visc_CSp => set_visc - call updateCFLtruncationValue(Time, CS%vertvisc_CSp, & + call updateCFLtruncationValue(Time, CS%vertvisc_CSp, US, & activate=is_new_run(restart_CS) ) if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp if (associated(OBC)) then CS%OBC => OBC - if (OBC%ramp) call update_OBC_ramp(Time, CS%OBC, & + if (OBC%ramp) call update_OBC_ramp(Time, CS%OBC, US, & activate=is_new_run(restart_CS) ) endif if (associated(update_OBC_CSp)) CS%update_OBC_CSp => update_OBC_CSp diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 88a11e071c..fcc4c3d49b 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -666,7 +666,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) cont_stencil = continuity_stencil(CS%continuity_CSp) call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv) - if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) + if (use_tides) call tidal_forcing_init(Time, G, US, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 26bd00aaf5..694d88f2ea 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -628,7 +628,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) cont_stencil = continuity_stencil(CS%continuity_CSp) call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv) - if (use_tides) call tidal_forcing_init(Time, G, param_file, CS%tides_CSp) + if (use_tides) call tidal_forcing_init(Time, G, US, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 6d8696216a..2c3f016005 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -264,7 +264,7 @@ module MOM_open_boundary logical :: add_tide_constituents = .false. !< If true, add tidal constituents to the boundary elevation !! and velocity. Will be set to true if n_tide_constituents > 0. character(len=2), allocatable, dimension(:) :: tide_names !< Names of tidal constituents to add to the boundary data. - real, allocatable, dimension(:) :: tide_frequencies !< Angular frequencies of chosen tidal constituents [s-1]. + real, allocatable, dimension(:) :: tide_frequencies !< Angular frequencies of chosen tidal constituents [T-1 ~> s-1]. real, allocatable, dimension(:) :: tide_eq_phases !< Equilibrium phases of chosen tidal constituents [rad]. real, allocatable, dimension(:) :: tide_fn !< Amplitude modulation of boundary tides by nodal cycle [nondim]. real, allocatable, dimension(:) :: tide_un !< Phase modulation of boundary tides by nodal cycle [rad]. @@ -305,8 +305,8 @@ module MOM_open_boundary !! the independence of the OBCs to this external data [L T-1 ~> m s-1]. logical :: ramp = .false. !< If True, ramp from zero to the external values for SSH. logical :: ramping_is_activated = .false. !< True if the ramping has been initialized - real :: ramp_timescale !< If ramp is True, use this timescale for ramping [s]. - real :: trunc_ramp_time !< If ramp is True, time after which ramp is done [s]. + real :: ramp_timescale !< If ramp is True, use this timescale for ramping [T ~> s]. + real :: trunc_ramp_time !< If ramp is True, time after which ramp is done [T ~> s]. real :: ramp_value !< If ramp is True, where we are on the ramp from !! zero to one [nondim]. type(time_type) :: ramp_start_time !< Time when model was started. @@ -627,7 +627,7 @@ subroutine open_boundary_config(G, US, param_file, OBC) "Symmetric memory must be used when using Flather OBCs.") ! Need to do this last, because it depends on time_interp_external_init having already been called if (OBC%add_tide_constituents) then - call initialize_obc_tides(OBC, param_file) + call initialize_obc_tides(OBC, US, param_file) ! Tide update is done within update_OBC_segment_data, so this should be true if tides are included. OBC%update_OBC = .true. endif @@ -948,8 +948,9 @@ subroutine initialize_segment_data(G, OBC, PF) end subroutine initialize_segment_data -subroutine initialize_obc_tides(OBC, param_file) +subroutine initialize_obc_tides(OBC, US, param_file) type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handle integer, dimension(3) :: tide_ref_date !< Reference date (t = 0) for tidal forcing (year, month, day). integer, dimension(3) :: nodal_ref_date !< Date to calculate nodal modulation for (year, month, day). @@ -1022,7 +1023,8 @@ subroutine initialize_obc_tides(OBC, param_file) "Frequency of the "//trim(OBC%tide_names(c))//" tidal constituent. "//& "This is only used if TIDES and TIDE_"//trim(OBC%tide_names(c))// & " are true, or if OBC_TIDE_N_CONSTITUENTS > 0 and "//trim(OBC%tide_names(c))//& - " is in OBC_TIDE_CONSTITUENTS.", units="s-1", default=tidal_frequency(trim(OBC%tide_names(c)))) + " is in OBC_TIDE_CONSTITUENTS.", & + units="s-1", default=tidal_frequency(trim(OBC%tide_names(c))), scale=US%T_to_s) ! Find equilibrium phase if needed if (OBC%add_eq_phase) then @@ -3727,7 +3729,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) real :: tidal_elev ! Interpolated tidal elevation at the OBC points [m] real, allocatable :: normal_trans_bt(:,:) ! barotropic transport [H L2 T-1 ~> m3 s-1] integer :: turns ! Number of index quarter turns - real :: time_delta ! Time since tidal reference date [s] + real :: time_delta ! Time since tidal reference date [T ~> s] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -3738,7 +3740,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) if (.not. associated(OBC)) return - if (OBC%add_tide_constituents) time_delta = time_type_to_real(Time - OBC%time_ref) + if (OBC%add_tide_constituents) time_delta = US%s_to_T * time_type_to_real(Time - OBC%time_ref) do n = 1, OBC%number_of_segments segment => OBC%segment(n) @@ -4336,14 +4338,15 @@ end subroutine update_OBC_segment_data !> Update the OBC ramp value as a function of time. !! If called with the optional argument activate=.true., record the !! value of Time as the beginning of the ramp period. -subroutine update_OBC_ramp(Time, OBC, activate) +subroutine update_OBC_ramp(Time, OBC, US, activate) type(time_type), target, intent(in) :: Time !< Current model time type(ocean_OBC_type), intent(inout) :: OBC !< Open boundary structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, optional, intent(in) :: activate !< Specify whether to record the value of !! Time as the beginning of the ramp period ! Local variables - real :: deltaTime ! The time since start of ramping [s] + real :: deltaTime ! The time since start of ramping [T ~> s] real :: wghtA ! A temporary variable used to set OBC%ramp_value [nondim] character(len=12) :: msg @@ -4359,7 +4362,7 @@ subroutine update_OBC_ramp(Time, OBC, activate) endif endif if (.not.OBC%ramping_is_activated) return - deltaTime = max( 0., time_type_to_real( Time - OBC%ramp_start_time ) ) + deltaTime = max( 0., US%s_to_T*time_type_to_real( Time - OBC%ramp_start_time ) ) if (deltaTime >= OBC%trunc_ramp_time) then OBC%ramp_value = 1.0 OBC%ramp = .false. ! This turns off ramping after this call diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index b8d5c44098..cc4517a473 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -11,6 +11,7 @@ module MOM_tidal_forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : field_exists, file_exists, MOM_read_data use MOM_time_manager, only : set_date, time_type, time_type_to_real, operator(-) +use MOM_unit_scaling, only : unit_scale_type implicit none ; private @@ -47,12 +48,12 @@ module MOM_tidal_forcing !! astronomical/equilibrium argument. real :: sal_scalar !< The constant of proportionality between sea surface !! height (really it should be bottom pressure) anomalies - !! and bottom geopotential anomalies. + !! and bottom geopotential anomalies [nondim]. integer :: nc !< The number of tidal constituents in use. real, dimension(MAX_CONSTITUENTS) :: & - freq, & !< The frequency of a tidal constituent [s-1]. - phase0, & !< The phase of a tidal constituent at time 0, in radians. - amp, & !< The amplitude of a tidal constituent at time 0 [m]. + freq, & !< The frequency of a tidal constituent [T-1 ~> s-1]. + phase0, & !< The phase of a tidal constituent at time 0 [rad]. + amp, & !< The amplitude of a tidal constituent at time 0 [Z ~> m]. love_no !< The Love number of a tidal constituent at time 0 [nondim]. integer :: struct(MAX_CONSTITUENTS) !< An encoded spatial structure for each constituent character (len=16) :: const_name(MAX_CONSTITUENTS) !< The name of each constituent @@ -62,13 +63,13 @@ module MOM_tidal_forcing !! tidal phases at t = 0. real, allocatable :: & sin_struct(:,:,:), & !< The sine and cosine based structures that can - cos_struct(:,:,:), & !< be associated with the astronomical forcing. + cos_struct(:,:,:), & !< be associated with the astronomical forcing [nondim]. cosphasesal(:,:,:), & !< The cosine and sine of the phase of the sinphasesal(:,:,:), & !< self-attraction and loading amphidromes. - ampsal(:,:,:), & !< The amplitude of the SAL [m]. + ampsal(:,:,:), & !< The amplitude of the SAL [Z ~> m]. cosphase_prev(:,:,:), & !< The cosine and sine of the phase of the sinphase_prev(:,:,:), & !< amphidromes in the previous tidal solutions. - amp_prev(:,:,:) !< The amplitude of the previous tidal solution [m]. + amp_prev(:,:,:) !< The amplitude of the previous tidal solution [Z ~> m]. end type tidal_forcing_CS integer :: id_clock_tides !< CPU clock for tides @@ -87,8 +88,9 @@ module MOM_tidal_forcing subroutine astro_longitudes_init(time_ref, longitudes) type(time_type), intent(in) :: time_ref !> Time to calculate longitudes for. type(astro_longitudes), intent(out) :: longitudes !> Lunar and solar longitudes at time_ref. - real :: D, T !> Date offsets - real, parameter :: PI = 4.0 * atan(1.0) !> 3.14159... + real :: D !> Time since the reference date [days] + real :: T !> Time in Julian centuries [centuries] + real, parameter :: PI = 4.0 * atan(1.0) !> 3.14159... [nondim] ! Find date at time_ref in days since 1900-01-01 D = time_type_to_real(time_ref - set_date(1900, 1, 1)) / (24.0 * 3600.0) ! Time since 1900-01-01 in Julian centuries @@ -176,44 +178,45 @@ end function tidal_frequency !> Find amplitude (f) and phase (u) modulation of tidal constituents by the 18.6 !! year nodal cycle. Values here follow Table I.6 in Kowalik and Luick, !! "Modern Theory and Practice of Tide Analysis and Tidal Power", 2019. -subroutine nodal_fu(constit, N, fn, un) - character (len=2), intent(in) :: constit !> Tidal constituent to find modulation for. - real, intent(in) :: N !> Longitude of ascending node [rad]. - !! Calculate using astro_longitudes_init. - real, parameter :: RADIANS = 4.0 * atan(1.0) / 180.0 !> Converts degrees to radians. - real, intent(out) :: & - fn, & !> Amplitude modulation [nondim] - un !> Phase modulation [rad] +subroutine nodal_fu(constit, nodelon, fn, un) + character (len=2), intent(in) :: constit !> Tidal constituent to find modulation for. + real, intent(in) :: nodelon !> Longitude of ascending node [rad], which + !! can be calculated using astro_longitudes_init. + real, intent(out) :: fn !> Amplitude modulation [nondim] + real, intent(out) :: un !> Phase modulation [rad] + + real, parameter :: RADIANS = 4.0 * atan(1.0) / 180.0 !> Converts degrees to radians [nondim] + select case (constit) case ("M2") - fn = 1.0 - 0.037 * cos(N) - un = -2.1 * RADIANS * sin(N) + fn = 1.0 - 0.037 * cos(nodelon) + un = -2.1 * RADIANS * sin(nodelon) case ("S2") fn = 1.0 ! Solar S2 has no amplitude modulation. un = 0.0 ! S2 has no phase modulation. case ("N2") - fn = 1.0 - 0.037 * cos(N) - un = -2.1 * RADIANS * sin(N) + fn = 1.0 - 0.037 * cos(nodelon) + un = -2.1 * RADIANS * sin(nodelon) case ("K2") - fn = 1.024 + 0.286 * cos(N) - un = -17.7 * RADIANS * sin(N) + fn = 1.024 + 0.286 * cos(nodelon) + un = -17.7 * RADIANS * sin(nodelon) case ("K1") - fn = 1.006 + 0.115 * cos(N) - un = -8.9 * RADIANS * sin(N) + fn = 1.006 + 0.115 * cos(nodelon) + un = -8.9 * RADIANS * sin(nodelon) case ("O1") - fn = 1.009 + 0.187 * cos(N) - un = 10.8 * RADIANS * sin(N) + fn = 1.009 + 0.187 * cos(nodelon) + un = 10.8 * RADIANS * sin(nodelon) case ("P1") fn = 1.0 ! P1 has no amplitude modulation. un = 0.0 ! P1 has no phase modulation. case ("Q1") - fn = 1.009 + 0.187 * cos(N) - un = 10.8 * RADIANS * sin(N) + fn = 1.009 + 0.187 * cos(nodelon) + un = 10.8 * RADIANS * sin(nodelon) case ("MF") - fn = 1.043 + 0.414 * cos(N) - un = -23.7 * RADIANS * sin(N) + fn = 1.043 + 0.414 * cos(nodelon) + un = -23.7 * RADIANS * sin(nodelon) case ("MM") - fn = 1.0 - 0.130 * cos(N) + fn = 1.0 - 0.130 * cos(nodelon) un = 0.0 ! MM has no phase modulation. case default call MOM_error(FATAL, "nodal_fu: unrecognized constituent") @@ -226,10 +229,11 @@ end subroutine nodal_fu !! while fields like the background viscosities are 2-D arrays. !! ALLOC is a macro defined in MOM_memory.h for allocate or nothing with !! static memory. -subroutine tidal_forcing_init(Time, G, param_file, CS) - type(time_type), intent(in) :: Time !< The current model time. - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. +subroutine tidal_forcing_init(Time, G, US, param_file, CS) + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. type(tidal_forcing_CS), intent(inout) :: CS !< Tidal forcing control struct ! Local variables @@ -237,15 +241,18 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) phase, & ! The phase of some tidal constituent. lat_rad, lon_rad ! Latitudes and longitudes of h-points in radians. real :: deg_to_rad - real, dimension(MAX_CONSTITUENTS) :: freq_def, phase0_def, amp_def, love_def + real, dimension(MAX_CONSTITUENTS) :: freq_def ! Default frequency for each tidal constituent [s-1] + real, dimension(MAX_CONSTITUENTS) :: phase0_def ! Default reference phase for each tidal constituent [rad] + real, dimension(MAX_CONSTITUENTS) :: amp_def ! Default amplitude for each tidal constituent [m] + real, dimension(MAX_CONSTITUENTS) :: love_def ! Default love number for each constituent [nondim] integer, dimension(3) :: tide_ref_date !< Reference date (t = 0) for tidal forcing. logical :: use_const ! True if a constituent is being used. logical :: use_M2, use_S2, use_N2, use_K2, use_K1, use_O1, use_P1, use_Q1 logical :: use_MF, use_MM logical :: tides ! True if a tidal forcing is to be used. logical :: FAIL_IF_MISSING = .true. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_tidal_forcing" ! This module's name. character(len=128) :: mesg character(len=200) :: tidal_input_files(4*MAX_CONSTITUENTS) @@ -389,68 +396,68 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) endif CS%time_ref = set_date(tide_ref_date(1), tide_ref_date(2), tide_ref_date(3)) endif - ! Set the parameters for all components that are in use. - ! Initialize reference time for tides and - ! find relevant lunar and solar longitudes at the reference time. + + ! Initialize reference time for tides and find relevant lunar and solar + ! longitudes at the reference time. if (CS%use_eq_phase) call astro_longitudes_init(CS%time_ref, CS%tidal_longitudes) + + ! Set the parameters for all components that are in use. c=0 if (use_M2) then c=c+1 ; CS%const_name(c) = "M2" ; CS%struct(c) = 2 - CS%love_no(c) = 0.693 ; CS%amp(c) = 0.242334 + CS%love_no(c) = 0.693 ; amp_def(c) = 0.242334 ! Default amplitude in m. endif if (use_S2) then c=c+1 ; CS%const_name(c) = "S2" ; CS%struct(c) = 2 - CS%love_no(c) = 0.693 ; CS%amp(c) = 0.112743 + CS%love_no(c) = 0.693 ; amp_def(c) = 0.112743 ! Default amplitude in m. endif if (use_N2) then c=c+1 ; CS%const_name(c) = "N2" ; CS%struct(c) = 2 - CS%love_no(c) = 0.693 ; CS%amp(c) = 0.046397 + CS%love_no(c) = 0.693 ; amp_def(c) = 0.046397 ! Default amplitude in m. endif if (use_K2) then c=c+1 ; CS%const_name(c) = "K2" ; CS%struct(c) = 2 - CS%love_no(c) = 0.693 ; CS%amp(c) = 0.030684 + CS%love_no(c) = 0.693 ; amp_def(c) = 0.030684 ! Default amplitude in m. endif if (use_K1) then c=c+1 ; CS%const_name(c) = "K1" ; CS%struct(c) = 1 - CS%love_no(c) = 0.736 ; CS%amp(c) = 0.141565 + CS%love_no(c) = 0.736 ; amp_def(c) = 0.141565 ! Default amplitude in m. endif if (use_O1) then c=c+1 ; CS%const_name(c) = "O1" ; CS%struct(c) = 1 - CS%love_no(c) = 0.695 ; CS%amp(c) = 0.100661 + CS%love_no(c) = 0.695 ; amp_def(c) = 0.100661 ! Default amplitude in m. endif if (use_P1) then c=c+1 ; CS%const_name(c) = "P1" ; CS%struct(c) = 1 - CS%love_no(c) = 0.706 ; CS%amp(c) = 0.046848 + CS%love_no(c) = 0.706 ; amp_def(c) = 0.046848 ! Default amplitude in m. endif if (use_Q1) then c=c+1 ; CS%const_name(c) = "Q1" ; CS%struct(c) = 1 - CS%love_no(c) = 0.695 ; CS%amp(c) = 0.019273 + CS%love_no(c) = 0.695 ; amp_def(c) = 0.019273 ! Default amplitude in m. endif if (use_MF) then c=c+1 ; CS%const_name(c) = "MF" ; CS%struct(c) = 3 - CS%love_no(c) = 0.693 ; CS%amp(c) = 0.042041 + CS%love_no(c) = 0.693 ; amp_def(c) = 0.042041 ! Default amplitude in m. endif if (use_MM) then c=c+1 ; CS%const_name(c) = "MM" ; CS%struct(c) = 3 - CS%love_no(c) = 0.693 ; CS%amp(c) = 0.022191 + CS%love_no(c) = 0.693 ; amp_def(c) = 0.022191 ! Default amplitude in m. endif ! Set defaults for all included constituents ! and things that can be set by functions do c=1,nc - CS%freq(c) = tidal_frequency(CS%const_name(c)) - freq_def(c) = CS%freq(c) + freq_def(c) = tidal_frequency(CS%const_name(c)) love_def(c) = CS%love_no(c) - amp_def(c) = CS%amp(c) CS%phase0(c) = 0.0 if (CS%use_eq_phase) then phase0_def(c) = eq_phase(CS%const_name(c), CS%tidal_longitudes) @@ -467,11 +474,11 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) "Frequency of the "//trim(CS%const_name(c))//" tidal constituent. "//& "This is only used if TIDES and TIDE_"//trim(CS%const_name(c))// & " are true, or if OBC_TIDE_N_CONSTITUENTS > 0 and "//trim(CS%const_name(c))// & - " is in OBC_TIDE_CONSTITUENTS.", units="s-1", default=freq_def(c)) + " is in OBC_TIDE_CONSTITUENTS.", units="s-1", default=freq_def(c), scale=US%T_to_s) call get_param(param_file, mdl, "TIDE_"//trim(CS%const_name(c))//"_AMP", CS%amp(c), & "Amplitude of the "//trim(CS%const_name(c))//" tidal constituent. "//& "This is only used if TIDES and TIDE_"//trim(CS%const_name(c))// & - " are true.", units="m", default=amp_def(c)) + " are true.", units="m", default=amp_def(c), scale=US%m_to_Z) call get_param(param_file, mdl, "TIDE_"//trim(CS%const_name(c))//"_PHASE_T0", CS%phase0(c), & "Phase of the "//trim(CS%const_name(c))//" tidal constituent at time 0. "//& "This is only used if TIDES and TIDE_"//trim(CS%const_name(c))// & @@ -484,8 +491,9 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) allocate(CS%ampsal(isd:ied,jsd:jed,nc)) do c=1,nc ! Read variables with names like PHASE_SAL_M2 and AMP_SAL_M2. - call find_in_files(tidal_input_files,"PHASE_SAL_"//trim(CS%const_name(c)),phase,G) - call find_in_files(tidal_input_files,"AMP_SAL_"//trim(CS%const_name(c)),CS%ampsal(:,:,c),G) + call find_in_files(tidal_input_files, "PHASE_SAL_"//trim(CS%const_name(c)), phase, G) + call find_in_files(tidal_input_files, "AMP_SAL_"//trim(CS%const_name(c)), CS%ampsal(:,:,c), & + G, scale=US%m_to_Z) call pass_var(phase, G%domain,complete=.false.) call pass_var(CS%ampsal(:,:,c),G%domain,complete=.true.) do j=js-1,je+1 ; do i=is-1,ie+1 @@ -501,8 +509,9 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) allocate(CS%amp_prev(isd:ied,jsd:jed,nc)) do c=1,nc ! Read variables with names like PHASE_PREV_M2 and AMP_PREV_M2. - call find_in_files(tidal_input_files,"PHASE_PREV_"//trim(CS%const_name(c)),phase,G) - call find_in_files(tidal_input_files,"AMP_PREV_"//trim(CS%const_name(c)),CS%amp_prev(:,:,c),G) + call find_in_files(tidal_input_files, "PHASE_PREV_"//trim(CS%const_name(c)), phase, G) + call find_in_files(tidal_input_files, "AMP_PREV_"//trim(CS%const_name(c)), CS%amp_prev(:,:,c), & + G, scale=US%m_to_Z) call pass_var(phase, G%domain,complete=.false.) call pass_var(CS%amp_prev(:,:,c),G%domain,complete=.true.) do j=js-1,je+1 ; do i=is-1,ie+1 @@ -518,18 +527,19 @@ end subroutine tidal_forcing_init !> This subroutine finds a named variable in a list of files and reads its !! values into a domain-decomposed 2-d array -subroutine find_in_files(filenames, varname, array, G) +subroutine find_in_files(filenames, varname, array, G, scale) character(len=*), dimension(:), intent(in) :: filenames !< The names of the files to search for the named variable character(len=*), intent(in) :: varname !< The name of the variable to read type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G)), intent(out) :: array !< The array to fill with the data + real, optional, intent(in) :: scale !< A factor by which to rescale the array. ! Local variables integer :: nf do nf=1,size(filenames) if (LEN_TRIM(filenames(nf)) == 0) cycle if (field_exists(filenames(nf), varname, MOM_domain=G%Domain)) then - call MOM_read_data(filenames(nf), varname, array, G%Domain) + call MOM_read_data(filenames(nf), varname, array, G%Domain, scale=scale) return endif enddo @@ -571,22 +581,22 @@ end subroutine tidal_forcing_sensitivity !! height. For now, eta and eta_tidal are both geopotential heights in depth !! units, but probably the input for eta should really be replaced with the !! column mass anomalies. -subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, m_to_Z) +subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(time_type), intent(in) :: Time !< The time for the caluculation. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The sea surface height anomaly from !! a time-mean geoid [Z ~> m]. real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential height !! anomalies [Z ~> m]. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tidal_forcing_CS), intent(in) :: CS !< The control structure returned by a !! previous call to tidal_forcing_init. - real, intent(in) :: m_to_Z !< A scaling factor from m to the units of eta. ! Local variables - real :: now ! The relative time in seconds. - real :: amp_cosomegat, amp_sinomegat - real :: cosomegat, sinomegat - real :: eta_prop ! The nondimenional constant of proportionality beteen eta and eta_tidal. + real :: now ! The relative time compared with the tidal reference [T ~> s] + real :: amp_cosomegat, amp_sinomegat ! The tidal amplitudes times the components of phase [Z ~> m] + real :: cosomegat, sinomegat ! The components of the phase [nondim] + real :: eta_prop ! The nondimenional constant of proportionality beteen eta and eta_tidal [nondim] integer :: i, j, c, m, is, ie, js, je, Isq, Ieq, Jsq, Jeq is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -598,7 +608,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, m_to_Z) return endif - now = time_type_to_real(Time - cs%time_ref) + now = US%s_to_T * time_type_to_real(Time - cs%time_ref) if (CS%USE_SAL_SCALAR .and. CS%USE_PREV_TIDES) then eta_prop = 2.0*CS%SAL_SCALAR @@ -614,8 +624,8 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, m_to_Z) do c=1,CS%nc m = CS%struct(c) - amp_cosomegat = m_to_Z*CS%amp(c)*CS%love_no(c) * cos(CS%freq(c)*now + CS%phase0(c)) - amp_sinomegat = m_to_Z*CS%amp(c)*CS%love_no(c) * sin(CS%freq(c)*now + CS%phase0(c)) + amp_cosomegat = CS%amp(c)*CS%love_no(c) * cos(CS%freq(c)*now + CS%phase0(c)) + amp_sinomegat = CS%amp(c)*CS%love_no(c) * sin(CS%freq(c)*now + CS%phase0(c)) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 eta_tidal(i,j) = eta_tidal(i,j) + (amp_cosomegat*CS%cos_struct(i,j,m) + & amp_sinomegat*CS%sin_struct(i,j,m)) @@ -626,7 +636,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, m_to_Z) cosomegat = cos(CS%freq(c)*now) sinomegat = sin(CS%freq(c)*now) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_tidal(i,j) = eta_tidal(i,j) + m_to_Z*CS%ampsal(i,j,c) * & + eta_tidal(i,j) = eta_tidal(i,j) + CS%ampsal(i,j,c) * & (cosomegat*CS%cosphasesal(i,j,c) + sinomegat*CS%sinphasesal(i,j,c)) enddo ; enddo enddo ; endif @@ -635,7 +645,7 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, m_to_Z) cosomegat = cos(CS%freq(c)*now) sinomegat = sin(CS%freq(c)*now) do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 - eta_tidal(i,j) = eta_tidal(i,j) - m_to_Z*CS%SAL_SCALAR*CS%amp_prev(i,j,c) * & + eta_tidal(i,j) = eta_tidal(i,j) - CS%SAL_SCALAR*CS%amp_prev(i,j,c) * & (cosomegat*CS%cosphase_prev(i,j,c) + sinomegat*CS%sinphase_prev(i,j,c)) enddo ; enddo enddo ; endif diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index adac9e83f4..d384500c3d 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -56,12 +56,12 @@ module MOM_vert_friction !! absolute velocities. real :: CFL_trunc !< Velocity components will be truncated when they !! are large enough that the corresponding CFL number - !! exceeds this value, nondim. + !! exceeds this value [nondim]. real :: CFL_report !< The value of the CFL number that will cause the - !! accelerations to be reported, nondim. CFL_report + !! accelerations to be reported [nondim]. CFL_report !! will often equal CFL_trunc. real :: truncRampTime !< The time-scale over which to ramp up the value of - !! CFL_trunc from CFL_truncS to CFL_truncE + !! CFL_trunc from CFL_truncS to CFL_truncE [T ~> s] real :: CFL_truncS !< The start value of CFL_trunc real :: CFL_truncE !< The end/target value of CFL_trunc logical :: CFLrampingIsActivated = .false. !< True if the ramping has been initialized @@ -105,7 +105,7 @@ module MOM_vert_friction !! thickness for viscosity. logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the !! answers from the end of 2018. Otherwise, use expressions that do not - !! use an arbitary and hard-coded maximum viscous coupling coefficient + !! use an arbitrary and hard-coded maximum viscous coupling coefficient !! between layers. logical :: debug !< If true, write verbose checksums for debugging purposes. integer :: nkml !< The number of layers in the mixed layer. @@ -533,7 +533,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & endif if (associated(ADp%du_dt_str) .and. associated(ADp%dv_dt_str)) then - ! Diagnostics for thickness x wind stress acclerations + ! Diagnostics for thickness x wind stress accelerations if (CS%id_h_du_dt_str > 0) call post_product_u(CS%id_h_du_dt_str, ADp%du_dt_str, ADp%diag_hu, G, nz, CS%diag) if (CS%id_h_dv_dt_str > 0) call post_product_v(CS%id_h_dv_dt_str, ADp%dv_dt_str, ADp%diag_hv, G, nz, CS%diag) @@ -555,11 +555,11 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: visc_rem_u !< Fraction of a time-step's worth of a - !! barotopic acceleration that a layer experiences after + !! barotropic acceleration that a layer experiences after !! viscosity is applied in the zonal direction [nondim] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & intent(inout) :: visc_rem_v !< Fraction of a time-step's worth of a - !! barotopic acceleration that a layer experiences after + !! barotropic acceleration that a layer experiences after !! viscosity is applied in the meridional direction [nondim] real, intent(in) :: dt !< Time increment [T ~> s] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -692,7 +692,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) a_shelf, & ! The drag coefficients across interfaces in water columns under ! ice shelves [Z T-1 ~> m s-1]. z_i ! An estimate of each interface's height above the bottom, - ! normalized by the bottom boundary layer thickness, nondim. + ! normalized by the bottom boundary layer thickness [nondim] real, dimension(SZIB_(G)) :: & kv_bbl, & ! The bottom boundary layer viscosity [Z2 T-1 ~> m2 s-1]. bbl_thick, & ! The bottom boundary layer thickness [H ~> m or kg m-2]. @@ -715,10 +715,10 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) ! than Hbbl into the interior. real :: topfn ! A function which goes from 1 at the top to 0 much more ! than Htbl into the interior. - real :: z2 ! The distance from the bottom, normalized by Hbbl, nondim. + real :: z2 ! The distance from the bottom, normalized by Hbbl [nondim] real :: z2_wt ! A nondimensional (0-1) weight used when calculating z2. real :: z_clear ! The clearance of an interface above the surrounding topography [H ~> m or kg m-2]. - real :: a_cpl_max ! The maximum drag doefficient across interfaces, set so that it will be + real :: a_cpl_max ! The maximum drag coefficient across interfaces, set so that it will be ! representable as a 32-bit float in MKS units [Z T-1 ~> m s-1] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -1193,7 +1193,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_neglect = GV%H_subroundoff if (CS%answers_2018) then - ! The maximum coupling coefficent was originally introduced to avoid + ! The maximum coupling coefficient was originally introduced to avoid ! truncation error problems in the tridiagonal solver. Effectively, the 1e-10 ! sets the maximum coupling coefficient increment to 1e10 m per timestep. I_amax = (1.0e-10*US%Z_to_m) * dt @@ -1759,7 +1759,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & call get_param(param_file, mdl, "CFL_TRUNCATE_RAMP_TIME", CS%truncRampTime, & "The time over which the CFL truncation value is ramped "//& "up at the beginning of the run.", & - units="s", default=0.) + units="s", default=0., scale=US%s_to_T) CS%CFL_truncE = CS%CFL_trunc call get_param(param_file, mdl, "CFL_TRUNCATE_START", CS%CFL_truncS, & "The start value of the truncation CFL number used when "//& @@ -1937,14 +1937,16 @@ end subroutine vertvisc_init !> Update the CFL truncation value as a function of time. !! If called with the optional argument activate=.true., record the !! value of Time as the beginning of the ramp period. -subroutine updateCFLtruncationValue(Time, CS, activate) +subroutine updateCFLtruncationValue(Time, CS, US, activate) type(time_type), target, intent(in) :: Time !< Current model time type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type logical, optional, intent(in) :: activate !< Specify whether to record the value of !! Time as the beginning of the ramp period ! Local variables - real :: deltaTime, wghtA + real :: deltaTime ! The time since CS%rampStartTime [T ~> s], which may be negative. + real :: wghtA ! The relative weight of the final value [nondim] character(len=12) :: msg if (CS%truncRampTime==0.) return ! This indicates to ramping is turned off @@ -1958,7 +1960,7 @@ subroutine updateCFLtruncationValue(Time, CS, activate) endif endif if (.not.CS%CFLrampingIsActivated) return - deltaTime = max( 0., time_type_to_real( Time - CS%rampStartTime ) ) + deltaTime = max( 0., US%s_to_T*time_type_to_real( Time - CS%rampStartTime ) ) if (deltaTime >= CS%truncRampTime) then CS%CFL_trunc = CS%CFL_truncE CS%truncRampTime = 0. ! This turns off ramping after this call @@ -1966,7 +1968,7 @@ subroutine updateCFLtruncationValue(Time, CS, activate) wghtA = min( 1., deltaTime / CS%truncRampTime ) ! Linear profile in time !wghtA = wghtA*wghtA ! Convert linear profile to parabolic profile in time !wghtA = wghtA*wghtA*(3. - 2.*wghtA) ! Convert linear profile to cosine profile - wghtA = 1. - ( (1. - wghtA)**2 ) ! Convert linear profiel to nverted parabolic profile + wghtA = 1. - ( (1. - wghtA)**2 ) ! Convert linear profile to inverted parabolic profile CS%CFL_trunc = CS%CFL_truncS + wghtA * ( CS%CFL_truncE - CS%CFL_truncS ) endif write(msg(1:12),'(es12.3)') CS%CFL_trunc From 5d4e8a19f3322e2eb4bb4adca95ac4e3044da022 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 22 Dec 2021 11:57:14 -0500 Subject: [PATCH 34/73] (*)Removed problematic offline tracer lines Commented out the problematic lines that Andrew Shao flagged in his review of MOM6 dev/gfdl PR #37. The model runs perfectly well in short offline-tracer test runs, and even gives bitwise identical output, perhaps because no layers were being abruptly flooded to 10^13 times their previous values. These omitted lines could change answers in some cases, so the lines in question have been retained in case the offline tracer code needs to be debugged layer and these mysterious (and seemingly unhelpful) lines turn out to have been necessary. All answers in the non-offline-tracer runs are bitwise identical. --- src/tracer/MOM_offline_aux.F90 | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index b5d9c38fac..1fd1e88d12 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -63,14 +63,16 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) h_new(i,j,k) = max(0.0, G%areaT(i,j)*h_pre(i,j,k) + & ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) - ! In the case that the layer is now dramatically thinner than it was previously, - ! add a bit of mass to avoid truncation errors. This will lead to - ! non-conservation of tracers - h_new(i,j,k) = h_new(i,j,k) + & - max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) + ! This line was used previously, but it makes no sense, as it applies to the case of + ! wetting, not drying, and it does not seem to serve any useful purpose. Test runs + ! without this line seem to work properly, but it is being retained in a comment + ! pending verification that it is in fact unnecessary. + + ! h_new(i,j,k) = h_new(i,j,k) + & + ! max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) ! Convert back to thickness - h_new(i,j,k) = h_new(i,j,k) * G%IareaT(i,j) + h_new(i,j,k) = max(GV%Angstrom_H, h_new(i,j,k) * G%IareaT(i,j)) enddo ; enddo enddo @@ -103,18 +105,24 @@ subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) do i=is-1,ie+1 ! Top layer h_new(i,j,1) = max(0.0, h_pre(i,j,1) + ((eb(i,j,1) - ea(i,j,2)) + ea(i,j,1))) - h_new(i,j,1) = h_new(i,j,1) + max(0.0, 1.0e-13*h_new(i,j,1) - h_pre(i,j,1)) + ! h_new(i,j,1) = h_new(i,j,1) + max(0.0, 1.0e-13*h_new(i,j,1) - h_pre(i,j,1)) ! Bottom layer h_new(i,j,nz) = max(0.0, h_pre(i,j,nz) + ((ea(i,j,nz) - eb(i,j,nz-1)) + eb(i,j,nz))) - h_new(i,j,nz) = h_new(i,j,nz) + max(0.0, 1.0e-13*h_new(i,j,nz) - h_pre(i,j,nz)) + ! h_new(i,j,nz) = h_new(i,j,nz) + max(0.0, 1.0e-13*h_new(i,j,nz) - h_pre(i,j,nz)) enddo ! Interior layers do k=2,nz-1 ; do i=is-1,ie+1 h_new(i,j,k) = max(0.0, h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & (eb(i,j,k) - ea(i,j,k+1)))) - h_new(i,j,k) = h_new(i,j,k) + max(0.0, 1.0e-13*h_new(i,j,k) - h_pre(i,j,k)) + + ! This line and its two counterparts above were used previously, but it makes no sense as + ! written because it acts in the case of wetting, not drying, and it does not seem to serve + ! any useful purpose. Test runs without these lines seem to work fine, but they are + ! being retained in comments pending verification that they are in fact unnecessary. + + ! h_new(i,j,k) = h_new(i,j,k) + max(0.0, 1.0e-13*h_new(i,j,k) - h_pre(i,j,k)) enddo ; enddo enddo From dad675ad84c966adf942c0cbb40993d589e347a6 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 22 Dec 2021 16:01:25 -0500 Subject: [PATCH 35/73] Fix badge URL for codecov --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index d041a47daf..46774baaf0 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,5 @@ [![Read The Docs Status](https://readthedocs.org/projects/mom6/badge/?badge=latest)](http://mom6.readthedocs.io/) -[![codecov](https://codecov.io/gh/NOAA-GFDL/MOM6/branch/dev%2Fmaster/graph/badge.svg)](https://codecov.io/gh/NOAA-GFDL/MOM6) +[![codecov](https://codecov.io/gh/NOAA-GFDL/MOM6/branch/dev/gfdl/graph/badge.svg?token=uF8SVydCdp)](https://codecov.io/gh/NOAA-GFDL/MOM6) # MOM6 From f35edbd9d5766f3a9b367ea2c8fc22b3a5bae547 Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Fri, 17 Dec 2021 09:42:04 -0500 Subject: [PATCH 36/73] Bugfix - calculate density integrals in ALE mode w/ pressure_reconstruction=0 --- src/core/MOM_PressureForce_FV.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 30b2e90d1a..49cf5d6063 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -245,7 +245,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ ! Calculate 4 integrals through the layer that are required in the ! subsequent calculation. if (use_EOS) then - if ( use_ALE ) then + if ( use_ALE .and. CS%Recon_Scheme .gt. 0 ) then if ( CS%Recon_Scheme == 1 ) then call int_spec_vol_dp_generic_plm( T_t(:,:,k), T_b(:,:,k), S_t(:,:,k), S_b(:,:,k), & p(:,:,K), p(:,:,K+1), alpha_ref, dp_neglect, p(:,:,nz+1), G%HI, & @@ -697,7 +697,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm ! assumed when regridding is activated. Otherwise, the previous version ! is used, whereby densities within each layer are constant no matter ! where the layers are located. - if ( use_ALE ) then + if ( use_ALE .and. CS%Recon_Scheme .gt. 0 ) then if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, & rho_ref, CS%Rho0, GV%g_Earth, dz_neglect, G%bathyT, & From f865b249e81313773ce1226f9eb94d59a02ce3fd Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 23 Dec 2021 15:48:52 -0500 Subject: [PATCH 37/73] Update MOM_PressureForce_FV.F90 Replace `.gt.` with `>` --- src/core/MOM_PressureForce_FV.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index 49cf5d6063..2a79486a5f 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -245,7 +245,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ ! Calculate 4 integrals through the layer that are required in the ! subsequent calculation. if (use_EOS) then - if ( use_ALE .and. CS%Recon_Scheme .gt. 0 ) then + if ( use_ALE .and. CS%Recon_Scheme > 0 ) then if ( CS%Recon_Scheme == 1 ) then call int_spec_vol_dp_generic_plm( T_t(:,:,k), T_b(:,:,k), S_t(:,:,k), S_b(:,:,k), & p(:,:,K), p(:,:,K+1), alpha_ref, dp_neglect, p(:,:,nz+1), G%HI, & @@ -697,7 +697,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm ! assumed when regridding is activated. Otherwise, the previous version ! is used, whereby densities within each layer are constant no matter ! where the layers are located. - if ( use_ALE .and. CS%Recon_Scheme .gt. 0 ) then + if ( use_ALE .and. CS%Recon_Scheme > 0 ) then if ( CS%Recon_Scheme == 1 ) then call int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, & rho_ref, CS%Rho0, GV%g_Earth, dz_neglect, G%bathyT, & From b628748dee57f7aa232844a5df84e05bfb8a435c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 16 Dec 2021 08:23:06 -0500 Subject: [PATCH 38/73] Correct comments describing generic_tracer args Corrected uninformative comments describing the some of the arguments to the stub routines in config_src/external/GFDL_ocean_BGC/generic_tracer.F90. The updated comments are consistent with how they are used in calls to these routines and with the underlying actual generic_tracer code if they are actually documented there. The previous comments had been added to existing undocumented code to satisfy the MOM6 requirement that there be a doxygen comment describing every argument to every routine, in the hopes that someone with familiarity with the generic tracer could work amend them to something more appropriate. However, "Unknown" is neither an accurate nor an informative description, and current MOM6 standards would demand that we reject any new code contributions with such poor interface documentation. All answers are bitwise identical, and only comments have changed. --- .../GFDL_ocean_BGC/generic_tracer.F90 | 73 +++++++++++-------- 1 file changed, 41 insertions(+), 32 deletions(-) diff --git a/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 b/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 index 4d2e4183f7..6bd445ae8b 100644 --- a/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 +++ b/config_src/external/GFDL_ocean_BGC/generic_tracer.F90 @@ -42,7 +42,7 @@ subroutine generic_tracer_init(isc,iec,jsc,jec,isd,ied,jsd,jed,nk,ntau,axes,grid integer, intent(in) :: jsd !< Data start index in j direction integer, intent(in) :: jed !< Data end index in j direction integer, intent(in) :: nk !< Number of levels in k direction - integer, intent(in) :: ntau !< Unknown + integer, intent(in) :: ntau !< The number of tracer time levels (always 1 for MOM6) integer, intent(in) :: axes(3) !< Domain axes? type(time_type), intent(in) :: init_time !< Time real, dimension(:,:,:),target, intent(in) :: grid_tmask !< Mask @@ -61,7 +61,7 @@ end subroutine generic_tracer_coupler_get !> Unknown subroutine generic_tracer_coupler_accumulate(IOB_struc, weight, model_time) type(coupler_2d_bc_type), intent(in) :: IOB_struc !< Ice Ocean Boundary flux structure - real, intent(in) :: weight !< Unknown + real, intent(in) :: weight !< A weight for accumulating these fluxes type(time_type), optional,intent(in) :: model_time !< Time end subroutine generic_tracer_coupler_accumulate @@ -69,44 +69,53 @@ end subroutine generic_tracer_coupler_accumulate subroutine generic_tracer_source(Temp,Salt,rho_dzt,dzt,hblt_depth,ilb,jlb,tau,dtts,& grid_dat,model_time,nbands,max_wavelength_band,sw_pen_band,opacity_band,internal_heat,& frunoff,grid_ht, current_wave_stress, sosga) - real, dimension(ilb:,jlb:,:), intent(in) :: Temp !< Potential temperature [deg C] - real, dimension(ilb:,jlb:,:), intent(in) :: Salt !< Salinity [psu] - real, dimension(ilb:,jlb:,:), intent(in) :: rho_dzt !< Unknown - real, dimension(ilb:,jlb:,:), intent(in) :: dzt !< Ocean layer thickness [m] - real, dimension(ilb:,jlb:), intent(in) :: hblt_depth !< Boundary layer depth - integer, intent(in) :: ilb !< Lower bounds of x extent of input arrays on data domain - integer, intent(in) :: jlb !< Lower bounds of y extent of input arrays on data domain - integer, intent(in) :: tau !< Time step index of %field - real, intent(in) :: dtts !< Unknown - real, dimension(ilb:,jlb:), intent(in) :: grid_dat !< Unknown + real, dimension(ilb:,jlb:,:), intent(in) :: Temp !< Potential temperature [deg C] + real, dimension(ilb:,jlb:,:), intent(in) :: Salt !< Salinity [psu] + real, dimension(ilb:,jlb:,:), intent(in) :: rho_dzt !< Mass per unit area of each layer [kg m-2] + real, dimension(ilb:,jlb:,:), intent(in) :: dzt !< Ocean layer thickness [m] + real, dimension(ilb:,jlb:), intent(in) :: hblt_depth !< Boundary layer depth [m] + integer, intent(in) :: ilb !< Lower bounds of x extent of input arrays on data domain + integer, intent(in) :: jlb !< Lower bounds of y extent of input arrays on data domain + integer, intent(in) :: tau !< Time step index of %field + real, intent(in) :: dtts !< The time step for this call [s] + real, dimension(ilb:,jlb:), intent(in) :: grid_dat !< Grid cell areas [m2] type(time_type), intent(in) :: model_time !< Time - integer, intent(in) :: nbands !< Unknown - real, dimension(:), intent(in) :: max_wavelength_band !< Unknown - real, dimension(:,ilb:,jlb:), intent(in) :: sw_pen_band !< Shortwave penetration - real, dimension(:,ilb:,jlb:,:), intent(in) :: opacity_band !< Unknown - real, dimension(ilb:,jlb:),optional, intent(in) :: internal_heat !< Unknown - real, dimension(ilb:,jlb:),optional, intent(in) :: frunoff !< Unknown - real, dimension(ilb:,jlb:),optional, intent(in) :: grid_ht !< Unknown - real, dimension(ilb:,jlb:),optional , intent(in) :: current_wave_stress !< Unknown - real, optional , intent(in) :: sosga !< Global average sea surface salinity + integer, intent(in) :: nbands !< The number of bands of penetrating shortwave radiation + real, dimension(:), intent(in) :: max_wavelength_band !< The maximum wavelength in each band + !! of penetrating shortwave radiation [nm] + real, dimension(:,ilb:,jlb:), intent(in) :: sw_pen_band !< Penetrating shortwave radiation per band [W m-2]. + !! The wavelength or angular direction band is the first index. + real, dimension(:,ilb:,jlb:,:), intent(in) :: opacity_band !< Opacity of seawater averaged over each band [m-1]. + !! The wavelength or angular direction band is the first index. + real, dimension(ilb:,jlb:),optional, intent(in) :: internal_heat !< Any internal or geothermal heat + !! sources that are applied to the ocean integrated + !! over this timestep [degC kg m-2] + real, dimension(ilb:,jlb:),optional, intent(in) :: frunoff !< Rate of iceberg calving [kg m-2 s-1] + real, dimension(ilb:,jlb:),optional, intent(in) :: grid_ht !< Unknown, and presently unused by MOM6 + real, dimension(ilb:,jlb:),optional , intent(in) :: current_wave_stress !< Unknown, and presently unused by MOM6 + real, optional , intent(in) :: sosga !< Global average sea surface salinity [ppt] end subroutine generic_tracer_source !> Update the tracers from bottom fluxes subroutine generic_tracer_update_from_bottom(dt, tau, model_time) - real, intent(in) :: dt !< Time step increment + real, intent(in) :: dt !< Time step increment [s] integer, intent(in) :: tau !< Time step index used for the concentration field type(time_type), intent(in) :: model_time !< Time end subroutine generic_tracer_update_from_bottom !> Vertically diffuse all generic tracers for GOLD ocean subroutine generic_tracer_vertdiff_G(h_old, ea, eb, dt, kg_m2_to_H, m_to_H, tau) - real, dimension(:,:,:), intent(in) :: h_old !< Unknown - real, dimension(:,:,:), intent(in) :: ea !< Unknown - real, dimension(:,:,:), intent(in) :: eb !< Unknown - real, intent(in) :: dt !< Unknown - real, intent(in) :: kg_m2_to_H !< Unknown - real, intent(in) :: m_to_H !< Unknown - integer, intent(in) :: tau !< Unknown + real, dimension(:,:,:), intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2] + real, dimension(:,:,:), intent(in) :: ea !< The amount of fluid entrained from the layer + !! above during this call [H ~> m or kg m-2] + real, dimension(:,:,:), intent(in) :: eb !< The amount of fluid entrained from the layer + !! below during this call [H ~> m or kg m-2] + real, intent(in) :: dt !< The amount of time covered by this call [s] + real, intent(in) :: kg_m2_to_H !< A unit conversion factor from mass per unit + !! area to thickness units [H m2 kg-1 ~> m3 kg-1 or 1] + real, intent(in) :: m_to_H !< A unit conversion factor from heights to + !! thickness units [H m-1 ~> 1 or kg m-3] + integer, intent(in) :: tau !< The time level to work on (always 1 for MOM6) end subroutine generic_tracer_vertdiff_G !> Set the coupler values for each generic tracer @@ -115,11 +124,11 @@ subroutine generic_tracer_coupler_set(IOB_struc, ST,SS,rho,ilb,jlb,tau, dzt, sos integer, intent(in) :: ilb !< Lower bounds of x extent of input arrays on data domain integer, intent(in) :: jlb !< Lower bounds of y extent of input arrays on data domain integer, intent(in) :: tau !< Time step index of %field - real, dimension(ilb:,jlb:), intent(in) :: ST !< Sea surface temperature [deg C] - real, dimension(ilb:,jlb:), intent(in) :: SS !< Sea surface salinity [psu] + real, dimension(ilb:,jlb:), intent(in) :: ST !< Sea surface temperature [degC] + real, dimension(ilb:,jlb:), intent(in) :: SS !< Sea surface salinity [ppt] real, dimension(ilb:,jlb:,:,:), intent(in) :: rho !< Ocean density [kg m-3] real, dimension(ilb:,jlb:,:), optional, intent(in) :: dzt !< Layer thickness [m] - real, optional, intent(in) :: sosga !< Unknown + real, optional, intent(in) :: sosga !< Global mean sea surface salinity [ppt] type(time_type),optional, intent(in) :: model_time !< Time end subroutine generic_tracer_coupler_set From 6bcea76f917d126da5976564cc347b1fd36ab41c Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Wed, 22 Dec 2021 15:48:55 -0500 Subject: [PATCH 39/73] Fixes an uninitialized logical in FMS_cap - A do_not_log depends on a logical that is only set conditionally. This initializes that logical when the corresponding parameter is not being read. - Unfortunately, this change MOM_parameter_doc.all for the coupled models. The .all pipeline uses the gnu compiler which was initializing this logical as .true. and thus logging the new parameter when it should not have been. Intel and PGI were initializing with .false. --- config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index cab870fed4..acbbc292de 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -1461,6 +1461,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, wind_stagger) call get_param(param_file, mdl, "SPEAR_ECDA_SST_RESTORE_TFREEZE", CS%trestore_SPEAR_ECDA, & "If true, modify SST restoring field using SSS state. This only modifies the "//& "restoring data that is within 0.0001degC of -1.8degC.", default=.false.) + else + CS%trestore_SPEAR_ECDA = .false. ! Needed to toggle logging of SPEAR_DTFREEZE_DS endif call get_param(param_file, mdl, "SPEAR_DTFREEZE_DS", CS%SPEAR_dTf_dS, & "The derivative of the freezing temperature with salinity.", & From d9d82e325f96229e04240a563e7465b03528747e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 23 Dec 2021 10:48:36 -0500 Subject: [PATCH 40/73] Eliminate unneeded diagnostic arrays in CorAdCalc Eliminated 4 unnecessary 3-d allocatable arrays and 8 2-d diagnostic arrays in CorAdCalc, and simplified the code calculating these diagnostics by using the post_product_[uv] and post_product_sum_[uv] routines. Also grouped the calls that allocate the memory that is still needed for diagnostics. This commit also includes a few other minor changes to clean up the documentation of variable intents and unit documentation in a handful of other places in the code: - Add intent declarations to the arguments to chksum2d() and chksum3d() - Corrected incorrect scale arguments for two (untested) checksum calls. - Corrected the documented units in several comments. All answers and output are bitwise identical. --- src/core/MOM_CoriolisAdv.F90 | 311 ++++-------------- src/framework/MOM_checksums.F90 | 8 +- .../MOM_state_initialization.F90 | 2 +- .../vertical/MOM_CVMix_conv.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 2 +- src/user/ISOMIP_initialization.F90 | 4 +- src/user/Kelvin_initialization.F90 | 2 +- src/user/Phillips_initialization.F90 | 2 +- 8 files changed, 80 insertions(+), 253 deletions(-) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 953d64c1f0..19f14ceac3 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -6,6 +6,8 @@ module MOM_CoriolisAdv !> \author Robert Hallberg, April 1994 - June 2002 use MOM_diag_mediator, only : post_data, query_averaging_enabled, diag_ctrl +use MOM_diag_mediator, only : post_product_u, post_product_sum_u +use MOM_diag_mediator, only : post_product_v, post_product_sum_v use MOM_diag_mediator, only : register_diag_field, safe_alloc_ptr, time_type use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type @@ -119,7 +121,7 @@ module MOM_CoriolisAdv !> Calculates the Coriolis and momentum advection contributions to the acceleration. subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv) - type(ocean_grid_type), intent(in) :: G !< Ocen grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1] @@ -223,25 +225,6 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv) real :: QUHeff,QVHeff ! More temporary variables [H L2 T-2 ~> m3 s-2 or kg s-2]. integer :: i, j, k, n, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz -! Diagnostics for fractional thickness-weighted terms - real, allocatable, dimension(:,:) :: & - hf_gKEu_2d, hf_gKEv_2d, & ! Depth sum of hf_gKEu, hf_gKEv [L T-2 ~> m s-2]. - hf_rvxu_2d, hf_rvxv_2d ! Depth sum of hf_rvxu, hf_rvxv [L T-2 ~> m s-2]. - - !real, allocatable, dimension(:,:,:) :: & - ! hf_gKEu, hf_gKEv, & ! accel. due to KE gradient x fract. thickness [L T-2 ~> m s-2]. - ! hf_rvxu, hf_rvxv ! accel. due to RV x fract. thickness [L T-2 ~> m s-2]. - ! 3D diagnostics hf_gKEu etc. are commented because there is no clarity on proper remapping grid option. - ! The code is retained for debugging purposes in the future. - -! Diagnostics for thickness multiplied momentum budget terms - real, allocatable, dimension(:,:,:) :: h_gKEu, h_gKEv ! h x gKEu, h x gKEv [H L T-2 ~> m2 s-2]. - real, allocatable, dimension(:,:,:) :: h_rvxv, h_rvxu ! h x rvxv, h x rvxu [H L T-2 ~> m2 s-2]. - -! Diagnostics for depth-integrated momentum budget terms - real, dimension(SZIB_(G),SZJ_(G)) :: intz_gKEu_2d, intz_rvxv_2d ! [H L T-2 ~> m2 s-2]. - real, dimension(SZI_(G),SZJB_(G)) :: intz_gKEv_2d, intz_rvxu_2d ! [H L T-2 ~> m2 s-2]. - ! To work, the following fields must be set outside of the usual ! is to ie range before this subroutine is called: ! v(is-1:ie+2,js-1:je+1), u(is-1:ie+1,js-1:je+2), h(is-1:ie+2,js-1:je+2), @@ -877,147 +860,26 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv) ! 3D diagnostics hf_gKEu etc. are commented because there is no clarity on proper remapping grid option. ! The code is retained for debugging purposes in the future. - !if (CS%id_hf_gKEu > 0) then - ! allocate(hf_gKEu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! hf_gKEu(I,j,k) = AD%gradKEu(I,j,k) * AD%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_gKEu, hf_gKEu, CS%diag) - !endif - - !if (CS%id_hf_gKEv > 0) then - ! allocate(hf_gKEv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! hf_gKEv(i,J,k) = AD%gradKEv(i,J,k) * AD%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_gKEv, hf_gKEv, CS%diag) - !endif - - if (CS%id_hf_gKEu_2d > 0) then - allocate(hf_gKEu_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_gKEu_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_gKEu_2d(I,j) = hf_gKEu_2d(I,j) + AD%gradKEu(I,j,k) * AD%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_gKEu_2d, hf_gKEu_2d, CS%diag) - deallocate(hf_gKEu_2d) - endif - - if (CS%id_hf_gKEv_2d > 0) then - allocate(hf_gKEv_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_gKEv_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_gKEv_2d(i,J) = hf_gKEv_2d(i,J) + AD%gradKEv(i,J,k) * AD%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_gKEv_2d, hf_gKEv_2d, CS%diag) - deallocate(hf_gKEv_2d) - endif - - if (CS%id_intz_gKEu_2d > 0) then - intz_gKEu_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - intz_gKEu_2d(I,j) = intz_gKEu_2d(I,j) + AD%gradKEu(I,j,k) * AD%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_gKEu_2d, intz_gKEu_2d, CS%diag) - endif - - if (CS%id_intz_gKEv_2d > 0) then - intz_gKEv_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - intz_gKEv_2d(i,J) = intz_gKEv_2d(i,J) + AD%gradKEv(i,J,k) * AD%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_gKEv_2d, intz_gKEv_2d, CS%diag) - endif - - !if (CS%id_hf_rvxv > 0) then - ! allocate(hf_rvxv(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - ! do k=1,nz ; do j=js,je ; do I=Isq,Ieq - ! hf_rvxv(I,j,k) = AD%rv_x_v(I,j,k) * AD%diag_hfrac_u(I,j,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_rvxv, hf_rvxv, CS%diag) - !endif - - !if (CS%id_hf_rvxu > 0) then - ! allocate(hf_rvxu(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - ! do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - ! hf_rvxu(i,J,k) = AD%rv_x_u(i,J,k) * AD%diag_hfrac_v(i,J,k) - ! enddo ; enddo ; enddo - ! call post_data(CS%id_hf_rvxu, hf_rvxu, CS%diag) - !endif - - if (CS%id_hf_rvxv_2d > 0) then - allocate(hf_rvxv_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_rvxv_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - hf_rvxv_2d(I,j) = hf_rvxv_2d(I,j) + AD%rv_x_v(I,j,k) * AD%diag_hfrac_u(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_rvxv_2d, hf_rvxv_2d, CS%diag) - deallocate(hf_rvxv_2d) - endif - - if (CS%id_hf_rvxu_2d > 0) then - allocate(hf_rvxu_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_rvxu_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - hf_rvxu_2d(i,J) = hf_rvxu_2d(i,J) + AD%rv_x_u(i,J,k) * AD%diag_hfrac_v(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_hf_rvxu_2d, hf_rvxu_2d, CS%diag) - deallocate(hf_rvxu_2d) - endif - - if (CS%id_h_gKEu > 0) then - allocate(h_gKEu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_gKEu(:,:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_gKEu(I,j,k) = AD%gradKEu(I,j,k) * AD%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_gKEu, h_gKEu, CS%diag) - deallocate(h_gKEu) - endif - if (CS%id_h_gKEv > 0) then - allocate(h_gKEv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_gKEv(:,:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_gKEv(i,J,k) = AD%gradKEv(i,J,k) * AD%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_gKEv, h_gKEv, CS%diag) - deallocate(h_gKEv) - endif - - if (CS%id_h_rvxv > 0) then - allocate(h_rvxv(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_rvxv(:,:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - h_rvxv(I,j,k) = AD%rv_x_v(I,j,k) * AD%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_rvxv, h_rvxv, CS%diag) - deallocate(h_rvxv) - endif - if (CS%id_h_rvxu > 0) then - allocate(h_rvxu(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_rvxu(:,:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - h_rvxu(i,J,k) = AD%rv_x_u(i,J,k) * AD%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_h_rvxu, h_rvxu, CS%diag) - deallocate(h_rvxu) - endif - - if (CS%id_intz_rvxv_2d > 0) then - intz_rvxv_2d(:,:) = 0.0 - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - intz_rvxv_2d(I,j) = intz_rvxv_2d(I,j) + AD%rv_x_v(I,j,k) * AD%diag_hu(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_rvxv_2d, intz_rvxv_2d, CS%diag) - endif - - if (CS%id_intz_rvxu_2d > 0) then - intz_rvxu_2d(:,:) = 0.0 - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - intz_rvxu_2d(i,J) = intz_rvxu_2d(i,J) + AD%rv_x_u(i,J,k) * AD%diag_hv(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_intz_rvxu_2d, intz_rvxu_2d, CS%diag) - endif + ! if (CS%id_hf_gKEu > 0) call post_product_u(CS%id_hf_gKEu, AD%gradKEu, AD%diag_hfrac_u, G, nz, CS%diag) + ! if (CS%id_hf_gKEv > 0) call post_product_v(CS%id_hf_gKEv, AD%gradKEv, AD%diag_hfrac_v, G, nz, CS%diag) + ! if (CS%id_hf_rvxv > 0) call post_product_u(CS%id_hf_rvxv, AD%rv_x_v, AD%diag_hfrac_u, G, nz, CS%diag) + ! if (CS%id_hf_rvxu > 0) call post_product_v(CS%id_hf_rvxu, AD%rv_x_u, AD%diag_hfrac_v, G, nz, CS%diag) + + if (CS%id_hf_gKEu_2d > 0) call post_product_sum_u(CS%id_hf_gKEu_2d, AD%gradKEu, AD%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_gKEv_2d > 0) call post_product_sum_v(CS%id_hf_gKEv_2d, AD%gradKEv, AD%diag_hfrac_v, G, nz, CS%diag) + if (CS%id_intz_gKEu_2d > 0) call post_product_sum_u(CS%id_intz_gKEu_2d, AD%gradKEu, AD%diag_hu, G, nz, CS%diag) + if (CS%id_intz_gKEv_2d > 0) call post_product_sum_v(CS%id_intz_gKEv_2d, AD%gradKEv, AD%diag_hv, G, nz, CS%diag) + + if (CS%id_hf_rvxv_2d > 0) call post_product_sum_u(CS%id_hf_rvxv_2d, AD%rv_x_v, AD%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_rvxu_2d > 0) call post_product_sum_v(CS%id_hf_rvxu_2d, AD%rv_x_u, AD%diag_hfrac_v, G, nz, CS%diag) + + if (CS%id_h_gKEu > 0) call post_product_u(CS%id_h_gKEu, AD%gradKEu, AD%diag_hu, G, nz, CS%diag) + if (CS%id_h_gKEv > 0) call post_product_v(CS%id_h_gKEv, AD%gradKEv, AD%diag_hv, G, nz, CS%diag) + if (CS%id_h_rvxv > 0) call post_product_u(CS%id_h_rvxv, AD%rv_x_v, AD%diag_hu, G, nz, CS%diag) + if (CS%id_h_rvxu > 0) call post_product_v(CS%id_h_rvxu, AD%rv_x_u, AD%diag_hv, G, nz, CS%diag) + + if (CS%id_intz_rvxv_2d > 0) call post_product_sum_u(CS%id_intz_rvxv_2d, AD%rv_x_v, AD%diag_hu, G, nz, CS%diag) + if (CS%id_intz_rvxu_2d > 0) call post_product_sum_v(CS%id_intz_rvxu_2d, AD%rv_x_u, AD%diag_hv, G, nz, CS%diag) endif end subroutine CorAdCalc @@ -1259,146 +1121,111 @@ subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS) CS%id_gKEu = register_diag_field('ocean_model', 'gKEu', diag%axesCuL, Time, & 'Zonal Acceleration from Grad. Kinetic Energy', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_gKEu > 0) call safe_alloc_ptr(AD%gradKEu,IsdB,IedB,jsd,jed,nz) CS%id_gKEv = register_diag_field('ocean_model', 'gKEv', diag%axesCvL, Time, & 'Meridional Acceleration from Grad. Kinetic Energy', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_gKEv > 0) call safe_alloc_ptr(AD%gradKEv,isd,ied,JsdB,JedB,nz) CS%id_rvxu = register_diag_field('ocean_model', 'rvxu', diag%axesCvL, Time, & 'Meridional Acceleration from Relative Vorticity', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_rvxu > 0) call safe_alloc_ptr(AD%rv_x_u,isd,ied,JsdB,JedB,nz) CS%id_rvxv = register_diag_field('ocean_model', 'rvxv', diag%axesCuL, Time, & 'Zonal Acceleration from Relative Vorticity', 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_rvxv > 0) call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) !CS%id_hf_gKEu = register_diag_field('ocean_model', 'hf_gKEu', diag%axesCuL, Time, & ! 'Fractional Thickness-weighted Zonal Acceleration from Grad. Kinetic Energy', & ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) - !if (CS%id_hf_gKEu > 0) then - ! call safe_alloc_ptr(AD%gradKEu,IsdB,IedB,jsd,jed,nz) - ! call safe_alloc_ptr(AD%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) - !endif - - !CS%id_hf_gKEv = register_diag_field('ocean_model', 'hf_gKEv', diag%axesCvL, Time, & - ! 'Fractional Thickness-weighted Meridional Acceleration from Grad. Kinetic Energy', & - ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) - !if (CS%id_hf_gKEv > 0) then - ! call safe_alloc_ptr(AD%gradKEv,isd,ied,JsdB,JedB,nz) - ! call safe_alloc_ptr(AD%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - !endif - CS%id_hf_gKEu_2d = register_diag_field('ocean_model', 'hf_gKEu_2d', diag%axesCu1, Time, & 'Depth-sum Fractional Thickness-weighted Zonal Acceleration from Grad. Kinetic Energy', & 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_hf_gKEu_2d > 0) then - call safe_alloc_ptr(AD%gradKEu,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(AD%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) - endif + !CS%id_hf_gKEv = register_diag_field('ocean_model', 'hf_gKEv', diag%axesCvL, Time, & + ! 'Fractional Thickness-weighted Meridional Acceleration from Grad. Kinetic Energy', & + ! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) CS%id_hf_gKEv_2d = register_diag_field('ocean_model', 'hf_gKEv_2d', diag%axesCv1, Time, & 'Depth-sum Fractional Thickness-weighted Meridional Acceleration from Grad. Kinetic Energy', & 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_hf_gKEv_2d > 0) then - call safe_alloc_ptr(AD%gradKEv,isd,ied,JsdB,JedB,nz) - call safe_alloc_ptr(AD%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - endif CS%id_h_gKEu = register_diag_field('ocean_model', 'h_gKEu', diag%axesCuL, Time, & 'Thickness Multiplied Zonal Acceleration from Grad. Kinetic Energy', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_h_gKEu > 0) then - call safe_alloc_ptr(AD%gradKEu,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(AD%diag_hu,IsdB,IedB,jsd,jed,nz) - endif - CS%id_intz_gKEu_2d = register_diag_field('ocean_model', 'intz_gKEu_2d', diag%axesCu1, Time, & 'Depth-integral of Zonal Acceleration from Grad. Kinetic Energy', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_intz_gKEu_2d > 0) then - call safe_alloc_ptr(AD%gradKEu,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(AD%diag_hu,IsdB,IedB,jsd,jed,nz) - endif CS%id_h_gKEv = register_diag_field('ocean_model', 'h_gKEv', diag%axesCvL, Time, & 'Thickness Multiplied Meridional Acceleration from Grad. Kinetic Energy', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_h_gKEv > 0) then - call safe_alloc_ptr(AD%gradKEv,isd,ied,JsdB,JedB,nz) - call safe_alloc_ptr(AD%diag_hv,isd,ied,JsdB,JedB,nz) - endif - CS%id_intz_gKEv_2d = register_diag_field('ocean_model', 'intz_gKEv_2d', diag%axesCv1, Time, & 'Depth-integral of Meridional Acceleration from Grad. Kinetic Energy', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_intz_gKEv_2d > 0) then - call safe_alloc_ptr(AD%gradKEv,isd,ied,JsdB,JedB,nz) - call safe_alloc_ptr(AD%diag_hv,isd,ied,JsdB,JedB,nz) - endif !CS%id_hf_rvxu = register_diag_field('ocean_model', 'hf_rvxu', diag%axesCvL, Time, & ! 'Fractional Thickness-weighted Meridional Acceleration from Relative Vorticity', & ! 'm-1 s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) - !if (CS%id_hf_rvxu > 0) then - ! call safe_alloc_ptr(AD%rv_x_u,isd,ied,JsdB,JedB,nz) - ! call safe_alloc_ptr(AD%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - !endif - - !CS%id_hf_rvxv = register_diag_field('ocean_model', 'hf_rvxv', diag%axesCuL, Time, & - ! 'Fractional Thickness-weighted Zonal Acceleration from Relative Vorticity', & - ! 'm-1 s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) - !if (CS%id_hf_rvxv > 0) then - ! call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) - ! call safe_alloc_ptr(AD%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) - !endif - CS%id_hf_rvxu_2d = register_diag_field('ocean_model', 'hf_rvxu_2d', diag%axesCv1, Time, & 'Depth-sum Fractional Thickness-weighted Meridional Acceleration from Relative Vorticity', & 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_hf_rvxu_2d > 0) then - call safe_alloc_ptr(AD%rv_x_u,isd,ied,JsdB,JedB,nz) - call safe_alloc_ptr(AD%diag_hfrac_v,isd,ied,JsdB,JedB,nz) - endif + !CS%id_hf_rvxv = register_diag_field('ocean_model', 'hf_rvxv', diag%axesCuL, Time, & + ! 'Fractional Thickness-weighted Zonal Acceleration from Relative Vorticity', & + ! 'm-1 s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2) CS%id_hf_rvxv_2d = register_diag_field('ocean_model', 'hf_rvxv_2d', diag%axesCu1, Time, & 'Depth-sum Fractional Thickness-weighted Zonal Acceleration from Relative Vorticity', & 'm s-2', conversion=US%L_T2_to_m_s2) - if (CS%id_hf_rvxv_2d > 0) then - call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(AD%diag_hfrac_u,IsdB,IedB,jsd,jed,nz) - endif CS%id_h_rvxu = register_diag_field('ocean_model', 'h_rvxu', diag%axesCvL, Time, & 'Thickness Multiplied Meridional Acceleration from Relative Vorticity', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_h_rvxu > 0) then - call safe_alloc_ptr(AD%rv_x_u,isd,ied,JsdB,JedB,nz) - call safe_alloc_ptr(AD%diag_hv,isd,ied,JsdB,JedB,nz) - endif - CS%id_intz_rvxu_2d = register_diag_field('ocean_model', 'intz_rvxu_2d', diag%axesCv1, Time, & 'Depth-integral of Meridional Acceleration from Relative Vorticity', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_intz_rvxu_2d > 0) then - call safe_alloc_ptr(AD%rv_x_u,isd,ied,JsdB,JedB,nz) - call safe_alloc_ptr(AD%diag_hv,isd,ied,JsdB,JedB,nz) - endif CS%id_h_rvxv = register_diag_field('ocean_model', 'h_rvxv', diag%axesCuL, Time, & 'Thickness Multiplied Zonal Acceleration from Relative Vorticity', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_h_rvxv > 0) then - call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(AD%diag_hu,IsdB,IedB,jsd,jed,nz) - endif - CS%id_intz_rvxv_2d = register_diag_field('ocean_model', 'intz_rvxv_2d', diag%axesCu1, Time, & 'Depth-integral of Fractional Thickness-weighted Zonal Acceleration from Relative Vorticity', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if (CS%id_intz_rvxv_2d > 0) then - call safe_alloc_ptr(AD%rv_x_v,IsdB,IedB,jsd,jed,nz) - call safe_alloc_ptr(AD%diag_hu,IsdB,IedB,jsd,jed,nz) + + ! Allocate memory needed for the diagnostics that have been enabled. + if ((CS%id_gKEu > 0) .or. (CS%id_hf_gKEu_2d > 0) .or. & + ! (CS%id_hf_gKEu > 0) .or. & + (CS%id_h_gKEu > 0) .or. (CS%id_intz_gKEu_2d > 0)) then + call safe_alloc_ptr(AD%gradKEu, IsdB, IedB, jsd, jed, nz) + endif + if ((CS%id_gKEv > 0) .or. (CS%id_hf_gKEv_2d > 0) .or. & + ! (CS%id_hf_gKEv > 0) .or. & + (CS%id_h_gKEv > 0) .or. (CS%id_intz_gKEv_2d > 0)) then + call safe_alloc_ptr(AD%gradKEv, isd, ied, JsdB, JedB, nz) + endif + if ((CS%id_rvxu > 0) .or. (CS%id_hf_rvxu_2d > 0) .or. & + ! (CS%id_hf_rvxu > 0) .or. & + (CS%id_h_rvxu > 0) .or. (CS%id_intz_rvxu_2d > 0)) then + call safe_alloc_ptr(AD%rv_x_u, isd, ied, JsdB, JedB, nz) + endif + if ((CS%id_rvxv > 0) .or. (CS%id_hf_rvxv_2d > 0) .or. & + ! (CS%id_hf_rvxv > 0) .or. & + (CS%id_h_rvxv > 0) .or. (CS%id_intz_rvxv_2d > 0)) then + call safe_alloc_ptr(AD%rv_x_v, IsdB, IedB, jsd, jed, nz) + endif + + if ((CS%id_hf_gKEv_2d > 0) .or. & + ! (CS%id_hf_gKEv > 0) .or. (CS%id_hf_rvxu > 0) .or. & + (CS%id_hf_rvxu_2d > 0)) then + call safe_alloc_ptr(AD%diag_hfrac_v, isd, ied, JsdB, JedB, nz) + endif + if ((CS%id_hf_gKEu_2d > 0) .or. & + ! (CS%id_hf_gKEu > 0) .or. (CS%id_hf_rvxv > 0) .or. & + (CS%id_hf_rvxv_2d > 0)) then + call safe_alloc_ptr(AD%diag_hfrac_u, IsdB, IedB, jsd, jed, nz) + endif + if ((CS%id_h_gKEu > 0) .or. (CS%id_intz_gKEu_2d > 0) .or. & + (CS%id_h_rvxv > 0) .or. (CS%id_intz_rvxv_2d > 0)) then + call safe_alloc_ptr(AD%diag_hu, IsdB, IedB, jsd, jed, nz) + endif + if ((CS%id_h_gKEv > 0) .or. (CS%id_intz_gKEv_2d > 0) .or. & + (CS%id_h_rvxu > 0) .or. (CS%id_intz_rvxu_2d > 0)) then + call safe_alloc_ptr(AD%diag_hv, isd, ied, JsdB, JedB, nz) endif end subroutine CoriolisAdv_init diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index 718a796802..fffdb9bed8 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -1944,8 +1944,8 @@ end subroutine chksum1d !> chksum2d does a checksum of all data in a 2-d array. subroutine chksum2d(array, mesg) - real, dimension(:,:) :: array !< The array to be checksummed - character(len=*) :: mesg !< An identifying message + real, dimension(:,:), intent(in) :: array !< The array to be checksummed + character(len=*), intent(in) :: mesg !< An identifying message integer :: xs,xe,ys,ye,i,j,sum1,bc real :: sum @@ -1972,8 +1972,8 @@ end subroutine chksum2d !> chksum3d does a checksum of all data in a 2-d array. subroutine chksum3d(array, mesg) - real, dimension(:,:,:) :: array !< The array to be checksummed - character(len=*) :: mesg !< An identifying message + real, dimension(:,:,:), intent(in) :: array !< The array to be checksummed + character(len=*), intent(in) :: mesg !< An identifying message integer :: xs,xe,ys,ye,zs,ze,i,j,k, bc,sum1 real :: sum diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 8055440cce..0d5342d9be 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -442,7 +442,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & if (new_sim) call pass_vector(u, v, G%Domain) if (debug .and. new_sim) then - call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1, scale=US%m_s_to_L_T) + call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1, scale=US%L_T_to_m_s) endif ! Optionally convert the thicknesses from m to kg m-2. This is particularly diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 6b44fce15e..fd2fe78907 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -275,7 +275,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) ! if (CS%id_kd_conv > 0) & ! call hchksum(Kd_conv, "MOM_CVMix_conv: Kd_conv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) ! if (CS%id_kv_conv > 0) & - ! call hchksum(Kv_conv, "MOM_CVMix_conv: Kv_conv", G%HI, haloshift=0, scale=US%m2_s_to_Z2_T) + ! call hchksum(Kv_conv, "MOM_CVMix_conv: Kv_conv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd, "MOM_CVMix_conv: Kd", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kv, "MOM_CVMix_conv: Kv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index f7d4b0cc0d..350f73d164 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1191,7 +1191,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) real :: Uh2 ! The squared magnitude of the difference between the velocity ! integrated through the mixed layer and the velocity of the ! interior layer layer times the depth of the the mixed layer - ! [H2 Z2 T-2 ~> m4 s-2 or kg2 m-2 s-2]. + ! [H2 L2 T-2 ~> m4 s-2 or kg2 m-2 s-2]. real :: htot_vel ! Sum of the layer thicknesses up to some point [H ~> m or kg m-2]. real :: hwtot ! Sum of the thicknesses used to calculate ! the near-bottom velocity magnitude [H ~> m or kg m-2]. diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 2ebac05a68..7386a008e6 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -42,9 +42,9 @@ module ISOMIP_initialization subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth [m ~> Z] + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum model depth [m ~> Z] + real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type ! Local variables diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 4c0c55f746..d1c89f14f3 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -119,7 +119,7 @@ end subroutine Kelvin_OBC_end subroutine Kelvin_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth [m ~> Z] + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 110a12c5f5..db1b512ca9 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -325,7 +325,7 @@ end function sech subroutine Phillips_initialize_topography(D, G, param_file, max_depth, US) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth [m ~> Z] + intent(out) :: D !< Ocean bottom depth [Z ~> m] type(param_file_type), intent(in) :: param_file !< Parameter file structure real, intent(in) :: max_depth !< Maximum model depth [Z ~> m] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type From 5ad8a2cd14716a50659317f7b1ca656b93a35a15 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 29 Dec 2021 08:32:32 -0500 Subject: [PATCH 41/73] Deleted commented out offline tracer lines Deleted four lines in the offline tracer code that had recently been commented out, along with the comments describing them. Further conversations had led to a consensus that these lines served no useful purpose, and are not worth keeping in the code, even in comments. Several excess spaces were also eliminated in MOM_offline_aux.F90. All answers and output are bitwise identical. --- src/tracer/MOM_offline_aux.F90 | 31 +++++++------------------------ 1 file changed, 7 insertions(+), 24 deletions(-) diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 1fd1e88d12..bdd6be4fe0 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -55,7 +55,7 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) ! Local variables integer :: i, j, k, m, is, ie, js, je, nz ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke do k=1,nz do i=is-1,ie+1 ; do j=js-1,je+1 @@ -63,14 +63,6 @@ subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) h_new(i,j,k) = max(0.0, G%areaT(i,j)*h_pre(i,j,k) + & ((uhtr(I-1,j,k) - uhtr(I,j,k)) + (vhtr(i,J-1,k) - vhtr(i,J,k)))) - ! This line was used previously, but it makes no sense, as it applies to the case of - ! wetting, not drying, and it does not seem to serve any useful purpose. Test runs - ! without this line seem to work properly, but it is being retained in a comment - ! pending verification that it is in fact unnecessary. - - ! h_new(i,j,k) = h_new(i,j,k) + & - ! max(GV%Angstrom_H, 1.0e-13*h_new(i,j,k) - G%areaT(i,j)*h_pre(i,j,k)) - ! Convert back to thickness h_new(i,j,k) = max(GV%Angstrom_H, h_new(i,j,k) * G%IareaT(i,j)) @@ -98,31 +90,22 @@ subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) ! Local variables integer :: i, j, k, m, is, ie, js, je, nz ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! Update h_new with convergence of vertical mass transports do j=js-1,je+1 do i=is-1,ie+1 ! Top layer h_new(i,j,1) = max(0.0, h_pre(i,j,1) + ((eb(i,j,1) - ea(i,j,2)) + ea(i,j,1))) - ! h_new(i,j,1) = h_new(i,j,1) + max(0.0, 1.0e-13*h_new(i,j,1) - h_pre(i,j,1)) ! Bottom layer h_new(i,j,nz) = max(0.0, h_pre(i,j,nz) + ((ea(i,j,nz) - eb(i,j,nz-1)) + eb(i,j,nz))) - ! h_new(i,j,nz) = h_new(i,j,nz) + max(0.0, 1.0e-13*h_new(i,j,nz) - h_pre(i,j,nz)) enddo ! Interior layers do k=2,nz-1 ; do i=is-1,ie+1 h_new(i,j,k) = max(0.0, h_pre(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & (eb(i,j,k) - ea(i,j,k+1)))) - - ! This line and its two counterparts above were used previously, but it makes no sense as - ! written because it acts in the case of wetting, not drying, and it does not seem to serve - ! any useful purpose. Test runs without these lines seem to work fine, but they are - ! being retained in comments pending verification that they are in fact unnecessary. - - ! h_new(i,j,k) = h_new(i,j,k) + max(0.0, 1.0e-13*h_new(i,j,k) - h_pre(i,j,k)) enddo ; enddo enddo @@ -165,7 +148,7 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) ! Hence, uh(I-1) is multipled by negative one, but uh(I) is not ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! Calculate top and bottom fluxes from ea and eb. Note the explicit negative signs ! to enforce the positive out convention @@ -247,7 +230,7 @@ subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) integer :: i, j, k, m, is, ie, js, je, nz ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke do j=js,je uh2d_sum(:) = 0.0 @@ -326,7 +309,7 @@ subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) integer :: i, j, k, m, is, ie, js, je, nz ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke do i=is,ie vh2d_sum(:) = 0.0 @@ -403,7 +386,7 @@ subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) integer :: i, j, k, m, is, ie, js, je, nz, k_rev ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke min_h = GV%Angstrom_H*0.1 @@ -502,7 +485,7 @@ subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) integer :: i, j, k, m, is, ie, js, je, nz, k_rev ! Set index-related variables for fields on T-grid - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke min_h = 0.1*GV%Angstrom_H From 2b2214d9b432071cbb2e7fd2d5d11a9395c32e62 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 23 Dec 2021 11:24:13 -0500 Subject: [PATCH 42/73] (*)Use por_face_area in zonal_face_thickness Use the por_face_area[UV] in the effective thickness calculations in zonal_face_thickness and merid_face_thickness, so that they are more consistent with their use elsewhere in the code for the relative weights in calculating the barotropic accelerations. Because these por_face_area arrays are still 1 in all test cases, the answers are unchanged in any test cases from before a few weeks ago, but there could be answer changes in cases that are using the very recently added capability (in PR #3) to set fractional face areas. This change was discussed with Sam Ditkovsky, and agreed that there is no reason to keep the ability to recover the previous answers in any cases that use the recently added partial face width option. This commit also expanded the comments describing the h_u and h_v arguments to btcalc(), zonal_face_thickness(), and merid_face_thickness() routines, the diag_h[uv] elements of the accel_diag_ptrs type and the h_u and h_v elements of the BT_cont_type. All answers and output are bitwise identical in the MOM6-examples test suite and TC tests, but answer changes are possible in cases using a very recently added code option. --- src/core/MOM_barotropic.F90 | 20 ++++++++++++----- src/core/MOM_continuity_PPM.F90 | 39 +++++++++++++++++++------------- src/core/MOM_variables.F90 | 40 ++++++++++++++++++++------------- 3 files changed, 63 insertions(+), 36 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index a7e8194a84..3cb1ebf399 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -3274,9 +3274,19 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(barotropic_CS), intent(inout) :: CS !< Barotropic control structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - optional, intent(in) :: h_u !< The specified thicknesses at u-points [H ~> m or kg m-2]. + optional, intent(in) :: h_u !< The specified effective thicknesses at u-points, + !! perhaps scaled down to account for viscosity and + !! fractional open areas [H ~> m or kg m-2]. These + !! are used here as non-normalized weights for each + !! layer that are converted the normalized weights + !! for determining the barotropic accelerations. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - optional, intent(in) :: h_v !< The specified thicknesses at v-points [H ~> m or kg m-2]. + optional, intent(in) :: h_v !< The specified effective thicknesses at v-points, + !! perhaps scaled down to account for viscosity and + !! fractional open areas [H ~> m or kg m-2]. These + !! are used here as non-normalized weights for each + !! layer that are converted the normalized weights + !! for determining the barotropic accelerations. logical, optional, intent(in) :: may_use_default !< An optional logical argument !! to indicate that the default velocity point !! thicknesses may be used for this particular @@ -3296,9 +3306,9 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: wt_arith ! The weight for the arithmetic mean thickness [nondim]. ! The harmonic mean uses a weight of (1 - wt_arith). - real :: Rh ! A ratio of summed thicknesses, nondim. - real :: e_u(SZIB_(G),SZK_(GV)+1) ! The interface heights at u-velocity and - real :: e_v(SZI_(G),SZK_(GV)+1) ! v-velocity points [H ~> m or kg m-2]. + real :: Rh ! A ratio of summed thicknesses [nondim] + real :: e_u(SZIB_(G),SZK_(GV)+1) ! The interface heights at u-velocity points [H ~> m or kg m-2] + real :: e_v(SZI_(G),SZK_(GV)+1) ! The interface heights at v-velocity points [H ~> m or kg m-2] real :: D_shallow_u(SZI_(G)) ! The height of the shallower of the adjacent bathymetric depths ! around a u-point (positive upward) [H ~> m or kg m-2] real :: D_shallow_v(SZIB_(G))! The height of the shallower of the adjacent bathymetric depths diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 7bc67e2fdf..95de2fd923 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -604,7 +604,8 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & endif end subroutine zonal_flux_layer -!> Sets the effective interface thickness at each zonal velocity point. +!> Sets the effective interface thickness at each zonal velocity point, optionally scaling +!! back these thicknesses to account for viscosity and fractional open areas. subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, & marginal, OBC, por_face_areaU, visc_rem_u) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. @@ -616,7 +617,10 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, !! reconstruction [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_R !< Right thickness in the !! reconstruction [H ~> m or kg m-2]. - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h_u !< Thickness at zonal faces [H ~> m or kg m-2]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h_u !< Effective thickness at zonal faces, + !! scaled down to account for the effects of + !! viscoity and the fractional open area + !! [H ~> m or kg m-2]. real, intent(in) :: dt !< Time increment [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. @@ -672,11 +676,12 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, else ; h_u(I,j,k) = h_avg ; endif enddo ; enddo ; enddo if (present(visc_rem_u)) then - !### The expression setting h_u should also be multiplied by por_face_areaU in this case, - ! and in the two OBC cases below with visc_rem_u. + ! Scale back the thickness to account for the effects of viscosity and the fractional open + ! thickness to give an appropriate non-normalized weight for each layer in determining the + ! barotropic acceleration. !$OMP parallel do default(shared) do k=1,nz ; do j=jsh,jeh ; do I=ish-1,ieh - h_u(I,j,k) = h_u(I,j,k) * visc_rem_u(I,j,k) !### * por_face_areaU(I,j,k) + h_u(I,j,k) = h_u(I,j,k) * (visc_rem_u(I,j,k) * por_face_areaU(I,j,k)) enddo ; enddo ; enddo endif @@ -689,7 +694,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, if (OBC%segment(n)%direction == OBC_DIRECTION_E) then if (present(visc_rem_u)) then ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed - h_u(I,j,k) = h(i,j,k) * visc_rem_u(I,j,k) !### * por_face_areaU(I,j,k) + h_u(I,j,k) = h(i,j,k) * (visc_rem_u(I,j,k) * por_face_areaU(I,j,k)) enddo enddo ; else ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed @@ -699,7 +704,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, else if (present(visc_rem_u)) then ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed - h_u(I,j,k) = h(i+1,j,k) * visc_rem_u(I,j,k) !### * por_face_areaU(I,j,k) + h_u(I,j,k) = h(i+1,j,k) * (visc_rem_u(I,j,k) * por_face_areaU(I,j,k)) enddo enddo ; else ; do k=1,nz do j = OBC%segment(n)%HI%jsd, OBC%segment(n)%HI%jed @@ -1427,19 +1432,22 @@ subroutine merid_flux_layer(v, h, h_L, h_R, vh, dvhdv, visc_rem, dt, G, US, J, & endif end subroutine merid_flux_layer -!> Sets the effective interface thickness at each meridional velocity point. +!> Sets the effective interface thickness at each meridional velocity point, optionally scaling +!! back these thicknesses to account for viscosity and fractional open areas. subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, & marginal, OBC, por_face_areaV, visc_rem_v) type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(in) :: v !< Meridional velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness used to calculate fluxes, !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_L !< Left thickness in the reconstruction, !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_R !< Right thickness in the reconstruction, !! [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: h_v !< Thickness at meridional faces, + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: h_v !< Effective thickness at meridional faces, + !! scaled down to account for the effects of + !! viscoity and the fractional open area !! [H ~> m or kg m-2]. real, intent(in) :: dt !< Time increment [T ~> s]. type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. @@ -1497,11 +1505,12 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, enddo ; enddo ; enddo if (present(visc_rem_v)) then - !### This expression setting h_v should also be multiplied by por_face_areaU in this case, - ! and in the two OBC cases below with visc_rem_u. + ! Scale back the thickness to account for the effects of viscosity and the fractional open + ! thickness to give an appropriate non-normalized weight for each layer in determining the + ! barotropic acceleration. !$OMP parallel do default(shared) do k=1,nz ; do J=jsh-1,jeh ; do i=ish,ieh - h_v(i,J,k) = h_v(i,J,k) * visc_rem_v(i,J,k) !### * por_face_areaV(i,J,k) + h_v(i,J,k) = h_v(i,J,k) * (visc_rem_v(i,J,k) * por_face_areaV(i,J,k)) enddo ; enddo ; enddo endif @@ -1514,7 +1523,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, if (OBC%segment(n)%direction == OBC_DIRECTION_N) then if (present(visc_rem_v)) then ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied - h_v(i,J,k) = h(i,j,k) * visc_rem_v(i,J,k) !### * por_face_areaV(i,J,k) + h_v(i,J,k) = h(i,j,k) * (visc_rem_v(i,J,k) * por_face_areaV(i,J,k)) enddo enddo ; else ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied @@ -1524,7 +1533,7 @@ subroutine merid_face_thickness(v, h, h_L, h_R, h_v, dt, G, GV, US, LB, vol_CFL, else if (present(visc_rem_v)) then ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied - h_v(i,J,k) = h(i,j+1,k) * visc_rem_v(i,J,k) !### * por_face_areaV(i,J,k) + h_v(i,J,k) = h(i,j+1,k) * (visc_rem_v(i,J,k) * por_face_areaV(i,J,k)) enddo enddo ; else ; do k=1,nz do i = OBC%segment(n)%HI%isd, OBC%segment(n)%HI%ied diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 5de7ea7319..ba5001e427 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -193,13 +193,15 @@ module MOM_variables real, pointer :: rv_x_v(:,:,:) => NULL() !< rv_x_v = rv * v at u [L T-2 ~> m s-2] real, pointer :: rv_x_u(:,:,:) => NULL() !< rv_x_u = rv * u at v [L T-2 ~> m s-2] - real, pointer :: diag_hfrac_u(:,:,:) => NULL() !< Fractional layer thickness at u points - real, pointer :: diag_hfrac_v(:,:,:) => NULL() !< Fractional layer thickness at v points - real, pointer :: diag_hu(:,:,:) => NULL() !< layer thickness at u points - real, pointer :: diag_hv(:,:,:) => NULL() !< layer thickness at v points + real, pointer :: diag_hfrac_u(:,:,:) => NULL() !< Fractional layer thickness at u points [nondim] + real, pointer :: diag_hfrac_v(:,:,:) => NULL() !< Fractional layer thickness at v points [nondim] + real, pointer :: diag_hu(:,:,:) => NULL() !< layer thickness at u points, modulated by the viscous + !! remnant and fractional open areas [H ~> m or kg m-2] + real, pointer :: diag_hv(:,:,:) => NULL() !< layer thickness at v points, modulated by the viscous + !! remnant and fractional open areas [H ~> m or kg m-2] - real, pointer :: visc_rem_u(:,:,:) => NULL() !< viscous remnant at u points - real, pointer :: visc_rem_v(:,:,:) => NULL() !< viscous remnant at v points + real, pointer :: visc_rem_u(:,:,:) => NULL() !< viscous remnant at u points [nondim] + real, pointer :: visc_rem_v(:,:,:) => NULL() !< viscous remnant at v points [nondim] end type accel_diag_ptrs @@ -283,10 +285,10 @@ module MOM_variables !! drawing from nearby to the west [H L ~> m2 or kg m-1]. real, allocatable :: FA_u_WW(:,:) !< The effective open face area for zonal barotropic transport !! drawing from locations far to the west [H L ~> m2 or kg m-1]. - real, allocatable :: uBT_WW(:,:) !< uBT_WW is the barotropic velocity [L T-1 ~> m s-1], beyond which the marginal - !! open face area is FA_u_WW. uBT_WW must be non-negative. - real, allocatable :: uBT_EE(:,:) !< uBT_EE is a barotropic velocity [L T-1 ~> m s-1], beyond which the marginal - !! open face area is FA_u_EE. uBT_EE must be non-positive. + real, allocatable :: uBT_WW(:,:) !< uBT_WW is the barotropic velocity [L T-1 ~> m s-1], beyond which the + !! marginal open face area is FA_u_WW. uBT_WW must be non-negative. + real, allocatable :: uBT_EE(:,:) !< uBT_EE is a barotropic velocity [L T-1 ~> m s-1], beyond which the + !! marginal open face area is FA_u_EE. uBT_EE must be non-positive. real, allocatable :: FA_v_NN(:,:) !< The effective open face area for meridional barotropic transport !! drawing from locations far to the north [H L ~> m2 or kg m-1]. real, allocatable :: FA_v_N0(:,:) !< The effective open face area for meridional barotropic transport @@ -295,12 +297,18 @@ module MOM_variables !! drawing from nearby to the south [H L ~> m2 or kg m-1]. real, allocatable :: FA_v_SS(:,:) !< The effective open face area for meridional barotropic transport !! drawing from locations far to the south [H L ~> m2 or kg m-1]. - real, allocatable :: vBT_SS(:,:) !< vBT_SS is the barotropic velocity, [L T-1 ~> m s-1], beyond which the marginal - !! open face area is FA_v_SS. vBT_SS must be non-negative. - real, allocatable :: vBT_NN(:,:) !< vBT_NN is the barotropic velocity, [L T-1 ~> m s-1], beyond which the marginal - !! open face area is FA_v_NN. vBT_NN must be non-positive. - real, allocatable :: h_u(:,:,:) !< An effective thickness at zonal faces [H ~> m or kg m-2]. - real, allocatable :: h_v(:,:,:) !< An effective thickness at meridional faces [H ~> m or kg m-2]. + real, allocatable :: vBT_SS(:,:) !< vBT_SS is the barotropic velocity, [L T-1 ~> m s-1], beyond which the + !! marginal open face area is FA_v_SS. vBT_SS must be non-negative. + real, allocatable :: vBT_NN(:,:) !< vBT_NN is the barotropic velocity, [L T-1 ~> m s-1], beyond which the + !! marginal open face area is FA_v_NN. vBT_NN must be non-positive. + real, allocatable :: h_u(:,:,:) !< An effective thickness at zonal faces, taking into account the effects + !! of vertical viscosity and fractional open areas [H ~> m or kg m-2]. + !! This is primarily used as a non-normalized weight in determining + !! the depth averaged accelerations for the barotropic solver. + real, allocatable :: h_v(:,:,:) !< An effective thickness at meridional faces, taking into account the effects + !! of vertical viscosity and fractional open areas [H ~> m or kg m-2]. + !! This is primarily used as a non-normalized weight in determining + !! the depth averaged accelerations for the barotropic solver. type(group_pass_type) :: pass_polarity_BT !< Structure for polarity group halo updates type(group_pass_type) :: pass_FA_uv !< Structure for face area group halo updates end type BT_cont_type From 2d3263108d677d12d6511301aa1537483060d4b5 Mon Sep 17 00:00:00 2001 From: Brandon Reichl Date: Sun, 2 Jan 2022 23:07:28 -0500 Subject: [PATCH 43/73] Option to homogenize forces and fluxes (#51) * Adds option to homogenize forces and fluxes fields - Adds functions to do global averages on U and V grids in MOM_spatial_means - Adds functionality to average all forcing and fluxes fields in MOM_forcing_types - Adds flag to average all forcing and fluxes in MOM.F90 - This new feature is primarily for running in single column like configurations with the coupler, which requires perfectly equal forcing across all cells. * Fixing ustar calculation in homogenize_mech_forcing - Adds in irho0 and sqrt that were missing in homogenize mech forcing. * Updates to homogenize_forcings options. - Correct issues in global_area_mean_u and global_area_mean_v to work with symmetric and rotated grids. - Add options to compute mean ustar or compute ustar from mean tau. - Add subroutines to replace averaging blocks in MOM_forcing_type. * Minor formatting updates - Move a division and reformat alignment in MOM_spatial_means.F90. - Remove a unused parameter in MOM_forcing_type.F90 - Reformat misalignment of an "if-block" in MOM_forcing_type.F90 * Remove obsolete netSalt flux homogenization - netSalt has been removed so no longer needs homogenized in the fluxes. * Fix 2d mean on U grid to use U mask * Remove whitespacace * Add do_not_log option to UPDATE_USTAR get_param --- src/core/MOM.F90 | 26 +++ src/core/MOM_forcing_type.F90 | 231 ++++++++++++++++++++++++++ src/diagnostics/MOM_spatial_means.F90 | 46 ++++- 3 files changed, 302 insertions(+), 1 deletion(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index ab6380f90a..b16681156b 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -82,6 +82,8 @@ module MOM use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing use MOM_forcing_type, only : deallocate_mech_forcing, deallocate_forcing_type use MOM_forcing_type, only : rotate_forcing, rotate_mech_forcing +use MOM_forcing_type, only : copy_common_forcing_fields, set_derived_forcing_fields +use MOM_forcing_type, only : homogenize_forcing, homogenize_mech_forcing use MOM_grid, only : ocean_grid_type, MOM_grid_init, MOM_grid_end use MOM_grid, only : set_first_direction, rescale_grid_bathymetry use MOM_hor_index, only : hor_index_type, hor_index_init @@ -207,6 +209,8 @@ module MOM type(ocean_grid_type) :: G_in !< Input grid metric type(ocean_grid_type), pointer :: G => NULL() !< Model grid metric logical :: rotate_index = .false. !< True if index map is rotated + logical :: homogenize_forcings = .false. !< True if all inputs are homogenized + logical :: update_ustar = .false. !< True to update ustar from homogenized tau type(verticalGrid_type), pointer :: & GV => NULL() !< structure containing vertical grid info @@ -579,6 +583,20 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS fluxes => fluxes_in endif + ! Homogenize the forces + if (CS%homogenize_forcings) then + ! Homogenize all forcing and fluxes fields. + call homogenize_mech_forcing(forces, G, US, GV%Rho0, CS%update_ustar) + ! Note the following computes the mean ustar as the mean of ustar rather than + ! ustar of the mean of tau. + call homogenize_forcing(fluxes, G) + if (CS%update_ustar) then + ! These calls corrects the ustar values + call copy_common_forcing_fields(forces, fluxes, G) + call set_derived_forcing_fields(forces, fluxes, G, US, GV%Rho0) + endif + endif + ! First determine the time step that is consistent with this call and an ! integer fraction of time_interval. if (do_dyn) then @@ -2144,6 +2162,14 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call callTree_waypoint("MOM parameters read (initialize_MOM)") + call get_param(param_file, "MOM", "HOMOGENIZE_FORCINGS", CS%homogenize_forcings, & + "If True, homogenize the forces and fluxes.", default=.false.) + call get_param(param_file, "MOM", "UPDATE_USTAR",CS%update_ustar, & + "If True, update ustar from homogenized tau when using the "//& + "HOMOGENIZE_FORCINGS option. Note that this will not work "//& + "with a non-zero gustiness factor.", default=.false., & + do_not_log=.not.CS%homogenize_forcings) + ! Grid rotation test call get_param(param_file, "MOM", "ROTATE_INDEX", CS%rotate_index, & "Enable rotation of the horizontal indices.", default=.false., & diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index c58340c498..3248c09fa4 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -17,6 +17,7 @@ module MOM_forcing_type use MOM_grid, only : ocean_grid_type use MOM_opacity, only : sumSWoverBands, optics_type, extract_optics_slice, optics_nbands use MOM_spatial_means, only : global_area_integral, global_area_mean +use MOM_spatial_means, only : global_area_mean_u, global_area_mean_v use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -35,6 +36,7 @@ module MOM_forcing_type public set_derived_forcing_fields, copy_back_forcing_fields public set_net_mass_forcing, get_net_mass_forcing public rotate_forcing, rotate_mech_forcing +public homogenize_forcing, homogenize_mech_forcing !> Allocate the fields of a (flux) forcing type, based on either a set of input !! flags for each group of fields, or a pre-allocated reference forcing. @@ -3358,6 +3360,7 @@ subroutine rotate_forcing(fluxes_in, fluxes, turns) if (do_iceberg) then call rotate_array(fluxes_in%ustar_berg, turns, fluxes%ustar_berg) call rotate_array(fluxes_in%area_berg, turns, fluxes%area_berg) + !BGR: pretty sure the following line isn't supposed to be here. call rotate_array(fluxes_in%iceshelf_melt, turns, fluxes%iceshelf_melt) endif @@ -3463,6 +3466,234 @@ subroutine rotate_mech_forcing(forces_in, turns, forces) forces%initialized = forces_in%initialized end subroutine rotate_mech_forcing +!< Homogenize the forcing fields from the input domain +subroutine homogenize_mech_forcing(forces, G, US, Rho0, UpdateUstar) + type(mech_forcing), intent(inout) :: forces !< Forcing on the input domain + type(ocean_grid_type), intent(in) :: G !< Grid metric of target forcing + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: Rho0 !< A reference density of seawater [R ~> kg m-3], + !! as used to calculate ustar. + logical, optional, intent(in) :: UpdateUstar !< A logical to determine if Ustar should be directly averaged + !! or updated from mean tau. + + real :: tx_mean, ty_mean, avg + real :: iRho0 + logical :: do_stress, do_ustar, do_shelf, do_press, do_iceberg, tau2ustar + integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isB = G%iscB ; ieB = G%iecB ; jsB = G%jscB ; jeB = G%jecB + + iRho0 = US%L_to_Z / Rho0 + + tau2ustar = .false. + if (present(UpdateUstar)) tau2ustar = UpdateUstar + + call get_mech_forcing_groups(forces, do_stress, do_ustar, do_shelf, & + do_press, do_iceberg) + + if (do_stress) then + tx_mean = global_area_mean_u(forces%taux, G) + do j=js,je ; do i=isB,ieB + if (G%mask2dCu(I,j) > 0.) forces%taux(I,j) = tx_mean + enddo ; enddo + ty_mean = global_area_mean_v(forces%tauy, G) + do j=jsB,jeB ; do i=is,ie + if (G%mask2dCv(i,J) > 0.) forces%tauy(i,J) = ty_mean + enddo ; enddo + if (tau2ustar) then + do j=js,je ; do i=is,ie + if (G%mask2dT(i,j) > 0.) forces%ustar(i,j) = sqrt(sqrt(tx_mean**2 + ty_mean**2)*iRho0) + enddo ; enddo + else + call homogenize_field_t(forces%ustar, G) + endif + else + if (do_ustar) then + call homogenize_field_t(forces%ustar, G) + endif + endif + + if (do_shelf) then + call homogenize_field_u(forces%rigidity_ice_u, G) + call homogenize_field_v(forces%rigidity_ice_v, G) + call homogenize_field_u(forces%frac_shelf_u, G) + call homogenize_field_v(forces%frac_shelf_v, G) + endif + + if (do_press) then + ! NOTE: p_surf_SSH either points to p_surf or p_surf_full + call homogenize_field_t(forces%p_surf, G) + call homogenize_field_t(forces%p_surf_full, G) + call homogenize_field_t(forces%net_mass_src, G) + endif + + if (do_iceberg) then + call homogenize_field_t(forces%area_berg, G) + call homogenize_field_t(forces%mass_berg, G) + endif + +end subroutine homogenize_mech_forcing + +!< Homogenize the fluxes +subroutine homogenize_forcing(fluxes, G) + type(forcing), intent(inout) :: fluxes !< Input forcing struct + type(ocean_grid_type), intent(in) :: G !< Grid metric of target forcing + + real :: avg + logical :: do_ustar, do_water, do_heat, do_salt, do_press, do_shelf, & + do_iceberg, do_heat_added, do_buoy + integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isB = G%iscB ; ieB = G%iecB ; jsB = G%jscB ; jeB = G%jecB + + call get_forcing_groups(fluxes, do_water, do_heat, do_ustar, do_press, & + do_shelf, do_iceberg, do_salt, do_heat_added, do_buoy) + + if (do_ustar) then + call homogenize_field_t(fluxes%ustar, G) + call homogenize_field_t(fluxes%ustar_gustless, G) + endif + + if (do_water) then + call homogenize_field_t(fluxes%evap, G) + call homogenize_field_t(fluxes%lprec, G) + call homogenize_field_t(fluxes%lprec, G) + call homogenize_field_t(fluxes%fprec, G) + call homogenize_field_t(fluxes%vprec, G) + call homogenize_field_t(fluxes%lrunoff, G) + call homogenize_field_t(fluxes%frunoff, G) + call homogenize_field_t(fluxes%seaice_melt, G) + call homogenize_field_t(fluxes%netMassOut, G) + call homogenize_field_t(fluxes%netMassIn, G) + !This was removed and I don't think replaced. Not needed? + !call homogenize_field_t(fluxes%netSalt, G) + endif + + if (do_heat) then + call homogenize_field_t(fluxes%seaice_melt_heat, G) + call homogenize_field_t(fluxes%sw, G) + call homogenize_field_t(fluxes%lw, G) + call homogenize_field_t(fluxes%latent, G) + call homogenize_field_t(fluxes%sens, G) + call homogenize_field_t(fluxes%latent_evap_diag, G) + call homogenize_field_t(fluxes%latent_fprec_diag, G) + call homogenize_field_t(fluxes%latent_frunoff_diag, G) + endif + + if (do_salt) call homogenize_field_t(fluxes%salt_flux, G) + + if (do_heat .and. do_water) then + call homogenize_field_t(fluxes%heat_content_cond, G) + call homogenize_field_t(fluxes%heat_content_icemelt, G) + call homogenize_field_t(fluxes%heat_content_lprec, G) + call homogenize_field_t(fluxes%heat_content_fprec, G) + call homogenize_field_t(fluxes%heat_content_vprec, G) + call homogenize_field_t(fluxes%heat_content_lrunoff, G) + call homogenize_field_t(fluxes%heat_content_frunoff, G) + call homogenize_field_t(fluxes%heat_content_massout, G) + call homogenize_field_t(fluxes%heat_content_massin, G) + endif + + if (do_press) call homogenize_field_t(fluxes%p_surf, G) + + if (do_shelf) then + call homogenize_field_t(fluxes%frac_shelf_h, G) + call homogenize_field_t(fluxes%ustar_shelf, G) + call homogenize_field_t(fluxes%iceshelf_melt, G) + endif + + if (do_iceberg) then + call homogenize_field_t(fluxes%ustar_berg, G) + call homogenize_field_t(fluxes%area_berg, G) + endif + + if (do_heat_added) then + call homogenize_field_t(fluxes%heat_added, G) + endif + + ! The following fields are handled by drivers rather than control flags. + if (associated(fluxes%sw_vis_dir)) & + call homogenize_field_t(fluxes%sw_vis_dir, G) + + if (associated(fluxes%sw_vis_dif)) & + call homogenize_field_t(fluxes%sw_vis_dif, G) + + if (associated(fluxes%sw_nir_dir)) & + call homogenize_field_t(fluxes%sw_nir_dir, G) + + if (associated(fluxes%sw_nir_dif)) & + call homogenize_field_t(fluxes%sw_nir_dif, G) + + if (associated(fluxes%salt_flux_in)) & + call homogenize_field_t(fluxes%salt_flux_in, G) + + if (associated(fluxes%salt_flux_added)) & + call homogenize_field_t(fluxes%salt_flux_added, G) + + if (associated(fluxes%p_surf_full)) & + call homogenize_field_t(fluxes%p_surf_full, G) + + if (associated(fluxes%buoy)) & + call homogenize_field_t(fluxes%buoy, G) + + if (associated(fluxes%TKE_tidal)) & + call homogenize_field_t(fluxes%TKE_tidal, G) + + if (associated(fluxes%ustar_tidal)) & + call homogenize_field_t(fluxes%ustar_tidal, G) + + ! TODO: tracer flux homogenization + ! Having a warning causes a lot of errors (each time step). + !if (coupler_type_initialized(fluxes%tr_fluxes)) & + ! call MOM_error(WARNING, "Homogenization of tracer BC fluxes not yet implemented.") + +end subroutine homogenize_forcing + +subroutine homogenize_field_t(var, G) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G), SZJ_(G)), intent(inout) :: var !< The variable to homogenize + + real :: avg + integer :: i, j, is, ie, js, je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + avg = global_area_mean(var, G) + do j=js,je ; do i=is,ie + if (G%mask2dT(i,j) > 0.) var(i,j) = avg + enddo ; enddo + +end subroutine homogenize_field_t + +subroutine homogenize_field_v(var, G) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G), SZJB_(G)), intent(inout) :: var !< The variable to homogenize + + real :: avg + integer :: i, j, is, ie, jsB, jeB + is = G%isc ; ie = G%iec ; jsB = G%jscB ; jeB = G%jecB + + avg = global_area_mean_v(var, G) + do J=jsB,jeB ; do i=is,ie + if (G%mask2dCv(i,J) > 0.) var(i,J) = avg + enddo ; enddo + +end subroutine homogenize_field_v + +subroutine homogenize_field_u(var, G) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G), SZJB_(G)), intent(inout) :: var !< The variable to homogenize + + real :: avg + integer :: i, j, isB, ieB, js, je + isB = G%iscB ; ieB = G%iecB ; js = G%jsc ; je = G%jec + + avg = global_area_mean_u(var, G) + do j=js,je ; do I=isB,ieB + if (G%mask2dCu(I,j) > 0.) var(I,j) = avg + enddo ; enddo + +end subroutine homogenize_field_u + !> \namespace mom_forcing_type !! !! \section section_fluxes Boundary fluxes diff --git a/src/diagnostics/MOM_spatial_means.F90 b/src/diagnostics/MOM_spatial_means.F90 index ffbdc5f810..7969ee11f8 100644 --- a/src/diagnostics/MOM_spatial_means.F90 +++ b/src/diagnostics/MOM_spatial_means.F90 @@ -17,7 +17,7 @@ module MOM_spatial_means #include public :: global_i_mean, global_j_mean -public :: global_area_mean, global_layer_mean +public :: global_area_mean, global_area_mean_u, global_area_mean_v, global_layer_mean public :: global_area_integral public :: global_volume_mean, global_mass_integral public :: adjust_area_mean_to_zero @@ -47,6 +47,50 @@ function global_area_mean(var, G, scale) end function global_area_mean +!> Return the global area mean of a variable. This uses reproducing sums. +function global_area_mean_v(var, G) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G), SZJB_(G)), intent(in) :: var !< The variable to average + + real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming + real :: global_area_mean_v + integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isB = G%iscB ; ieB = G%iecB ; jsB = G%jscB ; jeB = G%jecB + + tmpForSumming(:,:) = 0. + do J=js,je ; do i=is,ie + tmpForSumming(i,j) = G%areaT(i,j) * (var(i,J) * G%mask2dCv(i,J) + & + var(i,J-1) * G%mask2dCv(i,J-1)) & + / max(1.e-20,G%mask2dCv(i,J)+G%mask2dCv(i,J-1)) + enddo ; enddo + global_area_mean_v = reproducing_sum(tmpForSumming) * G%IareaT_global + +end function global_area_mean_v + +!> Return the global area mean of a variable on U grid. This uses reproducing sums. +function global_area_mean_u(var, G) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZIB_(G), SZJ_(G)), intent(in) :: var !< The variable to average + + real, dimension(SZI_(G), SZJ_(G)) :: tmpForSumming + real :: global_area_mean_u + integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isB = G%iscB ; ieB = G%iecB ; jsB = G%jscB ; jeB = G%jecB + + tmpForSumming(:,:) = 0. + do j=js,je ; do i=is,ie + tmpForSumming(i,j) = G%areaT(i,j) * (var(I,j) * G%mask2dCu(I,j) + & + var(I-1,j) * G%mask2dCu(I-1,j)) & + / max(1.e-20,G%mask2dCu(I,j)+G%mask2dCu(I-1,j)) + enddo ; enddo + global_area_mean_u = reproducing_sum(tmpForSumming) * G%IareaT_global + +end function global_area_mean_u + !> Return the global area integral of a variable, by default using the masked area from the !! grid, but an alternate could be used instead. This uses reproducing sums. function global_area_integral(var, G, scale, area) From df46be459304cc3571d0a2c7cc5727fed41ff076 Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Thu, 6 Jan 2022 18:28:22 -0500 Subject: [PATCH 44/73] Hydrostatic initialization in ice cavities (#41) * Hydrostatic initialization in ice cavities - Iteratively solve for the initial ice shelf displacement in cavities by calculating the pressure at the current displacement depth using the unperturbed profile. - This change should obsolete TRIM_IC_FOR_PSURF and DEPRESS_INITIAL_SURFACE for ice shelf applications and should work for arbitrary equations of state. - Existing implementations (e.g. ISOMIP) should turn off the above options in order to exercise this feature. - This code change should not impact non ice-shelf configurations or those with either of the above two options. * Addresses a number of issues identified in code review. * add appropriate intent to ice_shelf_query * fix unit scaling comments Co-authored-by: Marshall Ward --- src/core/MOM.F90 | 26 ++- src/ice_shelf/MOM_ice_shelf.F90 | 14 +- .../MOM_state_initialization.F90 | 163 +++++++++++++++--- 3 files changed, 164 insertions(+), 39 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index b16681156b..7a15d58bb1 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -283,7 +283,8 @@ module MOM type(time_type) :: dtbt_reset_interval !< A time_time representation of dtbt_reset_period. type(time_type) :: dtbt_reset_time !< The next time DTBT should be calculated. real, dimension(:,:), pointer :: frac_shelf_h => NULL() !< fraction of total area occupied - !! by ice shelf [nondim] + !! by ice shelf [nondim] + real, dimension(:,:), pointer :: mass_shelf => NULL() !< Mass of ice shelf [R Z ~> kg m-2] real, dimension(:,:,:), pointer :: & h_pre_dyn => NULL(), & !< The thickness before the transports [H ~> m or kg m-2]. T_pre_dyn => NULL(), & !< Temperature before the transports [degC]. @@ -1748,9 +1749,12 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & real, allocatable :: v_in(:,:,:) ! Initial meridional velocities [L T-1 ~> m s-1] real, allocatable :: h_in(:,:,:) ! Initial layer thicknesses [H ~> m or kg m-2] real, allocatable, target :: frac_shelf_in(:,:) ! Initial fraction of the total cell area occupied - ! by an ice shelf [nondim] + ! by an ice shelf [nondim] + real, allocatable, target :: mass_shelf_in(:,:) ! Initial mass of ice shelf contained within a grid cell + ! [R Z ~> kg m-2] real, allocatable, target :: T_in(:,:,:) ! Initial temperatures [degC] real, allocatable, target :: S_in(:,:,:) ! Initial salinities [ppt] + type(ocean_OBC_type), pointer :: OBC_in => NULL() type(sponge_CS), pointer :: sponge_in_CSp => NULL() type(ALE_sponge_CS), pointer :: ALE_sponge_in_CSp => NULL() @@ -2523,14 +2527,17 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! for legacy reasons. The actual ice shelf diag CS is internal to the ice shelf call initialize_ice_shelf(param_file, G_in, Time, ice_shelf_CSp, diag_ptr) allocate(frac_shelf_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed), source=0.0) + allocate(mass_shelf_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed), source=0.0) allocate(CS%frac_shelf_h(isd:ied, jsd:jed), source=0.0) - call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h) + allocate(CS%mass_shelf(isd:ied, jsd:jed), source=0.0) + call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h, CS%mass_shelf) ! MOM_initialize_state is using the unrotated metric call rotate_array(CS%frac_shelf_h, -turns, frac_shelf_in) + call rotate_array(CS%mass_shelf, -turns, mass_shelf_in) call MOM_initialize_state(u_in, v_in, h_in, CS%tv, Time, G_in, GV, US, & param_file, dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & sponge_in_CSp, ALE_sponge_in_CSp, oda_incupd_in_CSp, OBC_in, Time_in, & - frac_shelf_h=frac_shelf_in) + frac_shelf_h=frac_shelf_in, mass_shelf = mass_shelf_in) else call MOM_initialize_state(u_in, v_in, h_in, CS%tv, Time, G_in, GV, US, & param_file, dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & @@ -2574,16 +2581,17 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & deallocate(S_in) endif if (use_ice_shelf) & - deallocate(frac_shelf_in) + deallocate(frac_shelf_in,mass_shelf_in) else if (use_ice_shelf) then call initialize_ice_shelf(param_file, G, Time, ice_shelf_CSp, diag_ptr) allocate(CS%frac_shelf_h(isd:ied, jsd:jed), source=0.0) - call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h) + allocate(CS%mass_shelf(isd:ied, jsd:jed), source=0.0) + call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h, CS%mass_shelf) call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, US, & param_file, dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & CS%sponge_CSp, CS%ALE_sponge_CSp,CS%oda_incupd_CSp, CS%OBC, Time_in, & - frac_shelf_h=CS%frac_shelf_h) + frac_shelf_h=CS%frac_shelf_h, mass_shelf=CS%mass_shelf) else call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, US, & param_file, dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & @@ -2598,8 +2606,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif endif - if (use_ice_shelf .and. CS%debug) & + if (use_ice_shelf .and. CS%debug) then call hchksum(CS%frac_shelf_h, "MOM:frac_shelf_h", G%HI, haloshift=0) + call hchksum(CS%mass_shelf, "MOM:mass_shelf", G%HI, haloshift=0,scale=US%RZ_to_kg_m2) + endif call cpu_clock_end(id_clock_MOM_init) call callTree_waypoint("returned from MOM_initialize_state() (initialize_MOM)") diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 9dd3791211..13af5a936a 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -2032,11 +2032,12 @@ subroutine update_shelf_mass(G, US, CS, ISS, Time) end subroutine update_shelf_mass !> Save the ice shelf restart file -subroutine ice_shelf_query(CS, G, frac_shelf_h) +subroutine ice_shelf_query(CS, G, frac_shelf_h, mass_shelf) type(ice_shelf_CS), pointer :: CS !< ice shelf control structure type(ocean_grid_type), intent(in) :: G !< A pointer to an ocean grid control structure. - real, optional, dimension(SZI_(G),SZJ_(G)) :: frac_shelf_h !< - !< Ice shelf area fraction [nodim]. + real, optional, dimension(SZI_(G),SZJ_(G)), intent(out) :: frac_shelf_h !< Ice shelf area fraction [nodim]. + real, optional, dimension(SZI_(G),SZJ_(G)), intent(out) :: mass_shelf ! kg m-2] + integer :: i, j @@ -2047,6 +2048,13 @@ subroutine ice_shelf_query(CS, G, frac_shelf_h) enddo ; enddo endif + if (present(mass_shelf)) then + do j=G%jsd,G%jed ; do i=G%isd,G%ied + mass_shelf(i,j) = 0.0 + if (G%areaT(i,j)>0.) mass_shelf(i,j) = CS%ISS%mass_shelf(i,j) + enddo ; enddo + endif + end subroutine ice_shelf_query !> Save the ice shelf restart file diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0d5342d9be..f95192f5f8 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -117,7 +117,7 @@ module MOM_state_initialization !! conditions or by reading them from a restart (or saves) file. subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & restart_CS, ALE_CSp, tracer_Reg, sponge_CSp, & - ALE_sponge_CSp, oda_incupd_CSp, OBC, Time_in, frac_shelf_h) + ALE_sponge_CSp, oda_incupd_CSp, OBC, Time_in, frac_shelf_h, mass_shelf) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -147,6 +147,9 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: frac_shelf_h !< The fraction of the grid cell covered !! by a floating ice shelf [nondim]. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: mass_shelf !< The mass per unit area of the overlying + !! ice shelf [ R Z ~> kg m-2 ] ! Local variables real :: depth_tot(SZI_(G),SZJ_(G)) ! The nominal total depth of the ocean [Z ~> m] character(len=200) :: filename ! The name of an input file. @@ -158,6 +161,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & real :: vel_rescale ! A rescaling factor for velocities from the representation in ! a restart file to the internal representation in this run. real :: dt ! The baroclinic dynamics timestep for this run [T ~> s]. + logical :: from_Z_file, useALE logical :: new_sim integer :: write_geom @@ -404,6 +408,23 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & if (use_temperature .and. use_OBC) & call fill_temp_salt_segments(G, GV, OBC, tv) + ! Calculate the initial surface displacement under ice shelf + + call get_param(PF, mdl, "DEPRESS_INITIAL_SURFACE", depress_sfc, & + "If true, depress the initial surface to avoid huge "//& + "tsunamis when a large surface pressure is applied.", & + default=.false., do_not_log=just_read) + call get_param(PF, mdl, "TRIM_IC_FOR_P_SURF", trim_ic_for_p_surf, & + "If true, cuts way the top of the column for initial conditions "//& + "at the depth where the hydrostatic pressure matches the imposed "//& + "surface pressure which is read from file.", default=.false., & + do_not_log=just_read) + + if (new_sim) then + if (use_ice_shelf .and. present(mass_shelf) .and. .not. (trim_ic_for_p_surf .or. depress_sfc)) & + call calc_sfc_displacement(PF, G, GV, US, mass_shelf, tv, h) + endif + ! The thicknesses in halo points might be needed to initialize the velocities. if (new_sim) call pass_var(h, G%Domain) @@ -458,15 +479,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & call convert_thickness(h, G, GV, US, tv) ! Remove the mass that would be displaced by an ice shelf or inverse barometer. - call get_param(PF, mdl, "DEPRESS_INITIAL_SURFACE", depress_sfc, & - "If true, depress the initial surface to avoid huge "//& - "tsunamis when a large surface pressure is applied.", & - default=.false., do_not_log=just_read) - call get_param(PF, mdl, "TRIM_IC_FOR_P_SURF", trim_ic_for_p_surf, & - "If true, cuts way the top of the column for initial conditions "//& - "at the depth where the hydrostatic pressure matches the imposed "//& - "surface pressure which is read from file.", default=.false., & - do_not_log=just_read) if (depress_sfc .and. trim_ic_for_p_surf) call MOM_error(FATAL, "MOM_initialize_state: "//& "DEPRESS_INITIAL_SURFACE and TRIM_IC_FOR_P_SURF are exclusive and cannot both be True") if (new_sim .and. debug .and. (depress_sfc .or. trim_ic_for_p_surf)) & @@ -1035,7 +1047,7 @@ subroutine convert_thickness(h, G, GV, US, tv) end subroutine convert_thickness !> Depress the sea-surface based on an initial condition file -subroutine depress_surface(h, G, GV, US, param_file, tv, just_read) +subroutine depress_surface(h, G, GV, US, param_file, tv, just_read, z_top_shelf) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1045,6 +1057,8 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read) type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables logical, intent(in) :: just_read !< If true, this call will only read !! parameters without changing h. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: z_top_shelf !< Top interface position under ice shelf [Z ~> m] ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & eta_sfc ! The free surface height that the model should use [Z ~> m]. @@ -1057,30 +1071,40 @@ subroutine depress_surface(h, G, GV, US, param_file, tv, just_read) character(len=200) :: inputdir, eta_srf_file ! Strings for file/path character(len=200) :: filename, eta_srf_var ! Strings for file/path integer :: i, j, k, is, ie, js, je, nz + logical :: use_z_shelf is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - ! Read the surface height (or pressure) from a file. + use_z_shelf = present(z_top_shelf) - call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") - inputdir = slasher(inputdir) - call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_FILE", eta_srf_file,& - "The initial condition file for the surface height.", & - fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_VAR", eta_srf_var, & - "The initial condition variable for the surface height.",& - default="SSH", do_not_log=just_read) - filename = trim(inputdir)//trim(eta_srf_file) - if (.not.just_read) & - call log_param(param_file, mdl, "INPUTDIR/SURFACE_HEIGHT_IC_FILE", filename) - call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_SCALE", scale_factor, & - "A scaling factor to convert SURFACE_HEIGHT_IC_VAR into units of m", & - units="variable", default=1.0, scale=US%m_to_Z, do_not_log=just_read) + if (.not. use_z_shelf) then + ! Read the surface height (or pressure) from a file. - if (just_read) return ! All run-time parameters have been read, so return. + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) + call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_FILE", eta_srf_file,& + "The initial condition file for the surface height.", & + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_VAR", eta_srf_var, & + "The initial condition variable for the surface height.",& + default="SSH", do_not_log=just_read) + filename = trim(inputdir)//trim(eta_srf_file) + if (.not.just_read) & + call log_param(param_file, mdl, "INPUTDIR/SURFACE_HEIGHT_IC_FILE", filename) + + call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_SCALE", scale_factor, & + "A scaling factor to convert SURFACE_HEIGHT_IC_VAR into units of m", & + units="variable", default=1.0, scale=US%m_to_Z, do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. - call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain, scale=scale_factor) + call MOM_read_data(filename, eta_srf_var, eta_sfc, G%Domain, scale=scale_factor) + else + do j=js,je ; do i=is,ie + eta_sfc(i,j) = z_top_shelf(i,j) + enddo; enddo + endif ! Convert thicknesses to interface heights. call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) @@ -1201,6 +1225,88 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) end subroutine trim_for_ice +!> Calculate the hydrostatic equilibrium position of the surface under an ice shelf +subroutine calc_sfc_displacement(PF, G, GV, US, mass_shelf, tv, h) + type(param_file_type), intent(in) :: PF !< Parameter file structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: mass_shelf !< Ice shelf mass [R Z ~> kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + + real :: z_top_shelf(SZI_(G),SZJ_(G)) ! The depth of the top interface under ice shelves [Z ~> m] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & + eta ! The free surface height that the model should use [Z ~> m]. + ! temporary arrays + real, dimension(SZK_(GV)) :: rho_col ! potential density in the column for use in ice + real, dimension(SZK_(GV)) :: rho_h ! potential density multiplied by thickness [R Z ~> kg m-2 ] + real, dimension(SZK_(GV)) :: h_tmp ! temporary storage for thicknesses [H ~> m] + real, dimension(SZK_(GV)) :: p_ref ! pressure for density [R Z ~> kg m-2] + real, dimension(SZK_(GV)+1) :: ei_tmp, ei_orig ! temporary storage for interface positions [Z ~> m] + real :: z_top, z_col, mass_disp, residual, tol + integer :: is, ie, js, je, k, nz, i, j, max_iter, iter + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + + tol = 0.001 ! The initialization tolerance for ice shelf initialization (m) + call get_param(PF, mdl, "ICE_SHELF_INITIALIZATION_Z_TOLERANCE", tol, & + "A initialization tolerance for the calculation of the static "// & + "ice shelf displacement (m) using initial temperature and salinity profile.",& + default=tol, units="m", scale=US%m_to_Z) + max_iter = 1e3 + call MOM_mesg("Started calculating initial interface position under ice shelf ") + ! Convert thicknesses to interface heights. + call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) + do j = js, je ; do i = is, ie + iter = 1 + z_top_shelf(i,j) = 0.0 + p_ref(:) = tv%p_ref + if (G%mask2dT(i,j) .gt. 0. .and. mass_shelf(i,j) .gt. 0.) then + call calculate_density(tv%T(i,j,:), tv%S(i,j,:), P_Ref, rho_col, tv%eqn_of_state) + z_top = min(max(-1.0*mass_shelf(i,j)/rho_col(1),-G%bathyT(i,j)),0.) + h_tmp = 0.0 + z_col = 0.0 + ei_tmp(1:nz+1)=eta(i,j,1:nz+1) + ei_orig(1:nz+1)=eta(i,j,1:nz+1) + do k=1,nz+1 + if (ei_tmp(k) Adjust the layer thicknesses by removing the top of the water column above the !! depth where the hydrostatic pressure matches p_surf @@ -2597,6 +2703,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just old_remap=remap_old_alg, answers_2018=answers_2018 ) call ALE_remap_scalar(remapCS, G, GV, nkd, h1, tmpS1dIn, h, tv%S, all_cells=remap_full_column, & old_remap=remap_old_alg, answers_2018=answers_2018 ) + deallocate( h1 ) deallocate( tmpT1dIn ) deallocate( tmpS1dIn ) From f7a2254f3652727217d578f3aac4966a0d4da864 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Sat, 8 Jan 2022 06:12:14 -0500 Subject: [PATCH 45/73] Rewrite horizontal regridding to use netCDF wrapper functions (#48) * Refresh attempt to get rid of NetCDF calls * Fix comments * Set netCDF attrs in MOM_horizontal_regridding This patch sets the following netCDF attributes in the function `horiz_interp_and_extrap_tracer_record` via `read_attribute`. * `missing_value` (as `_FillValue`) * `scale_factor` * `add_offset` This resolves some issues related to uninitialized values. * read_variable_2d in horizontal remapping This patch extends the `read_variable` interface to include 2d array support, in order to facilitate domainless I/O via netCDF calls. This is far from the best implementation (e.g. read_variable_2d introduces another `broadcast` alongside the original one in the horizontal regridding) but it addresses the immediate issues with `MOM_read_data()`. * set default scale factor to 1 * add missing start/count arguments * Update MOM_io.F90 * Manage optional args in read_variable_2d This patch modifies read_variable_2d so that the size() tests of the optional arguments are applied before the call to nf90_get_var. The tests are also wrapped inside present() flags to avoid checking unassigned variables. Thanks to Robert Hallberg for the suggestions. Co-authored-by: Matthew Harrison --- src/framework/MOM_horizontal_regridding.F90 | 112 +++++--------- src/framework/MOM_io.F90 | 163 +++++++++++++++++++- 2 files changed, 204 insertions(+), 71 deletions(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index 0f16a5b301..de511688a9 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -16,9 +16,8 @@ module MOM_horizontal_regridding use MOM_interpolate, only : build_horiz_interp_weights, run_horiz_interp, horiz_interp_type use MOM_interp_infra, only : axistype, get_external_field_info, get_axis_data use MOM_time_manager, only : time_type - -use netcdf, only : NF90_OPEN, NF90_NOWRITE, NF90_GET_ATT, NF90_GET_VAR -use netcdf, only : NF90_INQ_VARID, NF90_INQUIRE_VARIABLE, NF90_INQUIRE_DIMENSION +use MOM_io, only : axis_info, get_axis_info, get_var_axes_info, MOM_read_data +use MOM_io, only : read_attribute, read_variable implicit none ; private @@ -304,10 +303,12 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, real :: max_lat, min_lat, pole, max_depth, npole real :: roundoff ! The magnitude of roundoff, usually ~2e-16. real :: add_offset, scale_factor + logical :: found_attr logical :: add_np logical :: is_ongrid character(len=8) :: laynum type(horiz_interp_type) :: Interp + type(axis_info), dimension(4) :: axes_info ! Axis information used for regridding integer :: is, ie, js, je ! compute domain indices integer :: isc, iec, jsc, jec ! global compute domain indices integer :: isg, ieg, jsg, jeg ! global extent @@ -334,6 +335,9 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, is_ongrid = .false. if (present(ongrid)) is_ongrid = ongrid + if (allocated(tr_z)) deallocate(tr_z) + if (allocated(mask_z)) deallocate(mask_z) + PI_180 = atan(1.0)/45. ! Open NetCDF file and if present, extract data and spatial coordinate information @@ -341,64 +345,23 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, call cpu_clock_begin(id_clock_read) - rcode = NF90_OPEN(filename, NF90_NOWRITE, ncid) - if (rcode /= 0) call MOM_error(FATAL,"error opening file "//trim(filename)//& - " in hinterp_extrap") - rcode = NF90_INQ_VARID(ncid, varnam, varid) - if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(varnam)//& - " in file "//trim(filename)//" in hinterp_extrap") - - rcode = NF90_INQUIRE_VARIABLE(ncid, varid, ndims=ndims, dimids=dims) - if (rcode /= 0) call MOM_error(FATAL, "Error inquiring about the dimensions of "//trim(varnam)//& - " in file "//trim(filename)//" in hinterp_extrap") - if (ndims < 3) call MOM_error(FATAL,"Variable "//trim(varnam)//" in file "//trim(filename)// & - " has too few dimensions to be read as a 3-d array.") - - rcode = NF90_INQUIRE_DIMENSION(ncid, dims(1), dim_name(1), len=id) - if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 1 data for "// & - trim(varnam)//" in file "// trim(filename)//" in hinterp_extrap") - rcode = NF90_INQ_VARID(ncid, dim_name(1), dim_id(1)) - if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(1))//& - " in file "//trim(filename)//" in hinterp_extrap") - rcode = NF90_INQUIRE_DIMENSION(ncid, dims(2), dim_name(2), len=jd) - if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 2 data for "// & - trim(varnam)//" in file "// trim(filename)//" in hinterp_extrap") - rcode = NF90_INQ_VARID(ncid, dim_name(2), dim_id(2)) - if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(2))//& - " in file "//trim(filename)//" in hinterp_extrap") - rcode = NF90_INQUIRE_DIMENSION(ncid, dims(3), dim_name(3), len=kd) - if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 3 data for "// & - trim(varnam)//" in file "// trim(filename)//" in hinterp_extrap") - rcode = NF90_INQ_VARID(ncid, dim_name(3), dim_id(3)) - if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(3))//& - " in file "//trim(filename)//" in hinterp_extrap") - - missing_value=0.0 - rcode = NF90_GET_ATT(ncid, varid, "_FillValue", missing_value) - if (rcode /= 0) call MOM_error(FATAL,"error finding missing value for "//trim(varnam)//& - " in file "// trim(filename)//" in hinterp_extrap") - - rcode = NF90_GET_ATT(ncid, varid, "add_offset", add_offset) - if (rcode /= 0) add_offset = 0.0 - - rcode = NF90_GET_ATT(ncid, varid, "scale_factor", scale_factor) - if (rcode /= 0) scale_factor = 1.0 + call get_var_axes_info(trim(filename), trim(varnam), axes_info) + + if (allocated(z_in)) deallocate(z_in) + if (allocated(z_edges_in)) deallocate(z_edges_in) + if (allocated(tr_z)) deallocate(tr_z) + if (allocated(mask_z)) deallocate(mask_z) + + call get_axis_info(axes_info(1),ax_size=id) + call get_axis_info(axes_info(2),ax_size=jd) + call get_axis_info(axes_info(3),ax_size=kd) allocate(lon_in(id), lat_in(jd), z_in(kd), z_edges_in(kd+1)) allocate(tr_z(isd:ied,jsd:jed,kd), mask_z(isd:ied,jsd:jed,kd)) - start = 1 ; count = 1 ; count(1) = id - rcode = NF90_GET_VAR(ncid, dim_id(1), lon_in, start, count) - if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 1 values for var_name "// & - trim(varnam)//",dim_name "//trim(dim_name(1))//" in file "// trim(filename)//" in hinterp_extrap") - start = 1 ; count = 1 ; count(1) = jd - rcode = NF90_GET_VAR(ncid, dim_id(2), lat_in, start, count) - if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 2 values for var_name "// & - trim(varnam)//",dim_name "//trim(dim_name(2))//" in file "// trim(filename)//" in hinterp_extrap") - start = 1 ; count = 1 ; count(1) = kd - rcode = NF90_GET_VAR(ncid, dim_id(3), z_in, start, count) - if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 3 values for var_name "// & - trim(varnam//",dim_name "//trim(dim_name(3)))//" in file "// trim(filename)//" in hinterp_extrap") + call get_axis_info(axes_info(1),ax_data=lon_in) + call get_axis_info(axes_info(2),ax_data=lat_in) + call get_axis_info(axes_info(3),ax_data=z_in) call cpu_clock_end(id_clock_read) @@ -422,6 +385,21 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, endif ! construct level cell boundaries as the mid-point between adjacent centers + ! Set the I/O attributes + call read_attribute(trim(filename), "_FillValue", missing_value, & + varname=trim(varnam), found=found_attr) + if (.not. found_attr) call MOM_error(FATAL, & + "error finding missing value for " // trim(varnam) // & + " in file " // trim(filename) // " in hinterp_extrap") + + call read_attribute(trim(filename), "scale_factor", scale_factor, & + varname=trim(varnam), found=found_attr) + if (.not. found_attr) scale_factor = 1. + + call read_attribute(trim(filename), "add_offset", add_offset, & + varname=trim(varnam), found=found_attr) + if (.not. found_attr) add_offset = 0. + z_edges_in(1) = 0.0 do K=2,kd z_edges_in(K) = 0.5*(z_in(k-1)+z_in(k)) @@ -458,12 +436,8 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, mask_in = 0.0 if (is_ongrid) then start(1) = is+G%HI%idg_offset ; start(2) = js+G%HI%jdg_offset ; start(3) = k - count(1) = ie-is+1 ; count(2) = je-js+1; count(3) = 1 - rcode = NF90_GET_VAR(ncid,varid, tr_in, start, count) - if (rcode /= 0) call MOM_error(FATAL,"horiz_interp_and_extrap_tracer_record: "//& - "error reading level "//trim(laynum)//" of variable "//& - trim(varnam)//" in file "// trim(filename)) - + count(1) = ie-is+1 ; count(2) = je-js+1; count(3) = 1; start(4) = 1; count(4) = 1 + call MOM_read_data(trim(filename), trim(varnam), tr_in, G%Domain, timelevel=1) do j=js,je do i=is,ie if (abs(tr_in(i,j)-missing_value) > abs(roundoff*missing_value)) then @@ -474,15 +448,11 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, endif enddo enddo - else + start(:) = 1 ; start(3) = k + count(:) = 1 ; count(1) = id ; count(2) = jd + call read_variable(trim(filename), trim(varnam), tr_in, start=start, nread=count) if (is_root_pe()) then - start = 1 ; start(3) = k ; count(:) = 1 ; count(1) = id ; count(2) = jd - rcode = NF90_GET_VAR(ncid,varid, tr_in, start, count) - if (rcode /= 0) call MOM_error(FATAL,"horiz_interp_and_extrap_tracer_record: "//& - "error reading level "//trim(laynum)//" of variable "//& - trim(varnam)//" in file "// trim(filename)) - if (add_np) then pole = 0.0 ; npole = 0.0 do i=1,id @@ -603,6 +573,8 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, enddo ! kd + deallocate(lon_in, lat_in) + end subroutine horiz_interp_and_extrap_tracer_record !> Extrapolate and interpolate using a FMS time interpolation handle diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 563f9f9f8a..2b8fb210d5 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -51,6 +51,8 @@ module MOM_io public :: slasher, write_field, write_version_number public :: io_infra_init, io_infra_end public :: stdout_if_root +public :: get_var_axes_info +public :: get_axis_info ! This is used to set up information descibing non-domain-decomposed axes. public :: axis_info, set_axis_info, delete_axis_info ! This is used to set up global file attributes @@ -98,6 +100,7 @@ module MOM_io interface read_variable module procedure read_variable_0d, read_variable_0d_int module procedure read_variable_1d, read_variable_1d_int + module procedure read_variable_2d end interface read_variable !> Read a global or variable attribute from a named netCDF file using netCDF calls @@ -887,6 +890,65 @@ subroutine read_variable_1d_int(filename, varname, var, ncid_in) call broadcast(var, size(var), blocking=.true.) end subroutine read_variable_1d_int +!> Read a 2d array from a netCDF input file and save to a variable. +!! +!! Start and nread ranks may exceed var, but must match the rank of the +!! variable in the netCDF file. This allows for reading slices of larger +!! arrays. +!! +!! I/O occurs only on the root PE, and data is broadcast to other ranks. +!! Due to potentially large memory communication and storage, this subroutine +!! should only be used when domain-decomposition is unavaialable. +subroutine read_variable_2d(filename, varname, var, start, nread, ncid_in) + character(len=*), intent(in) :: filename !< Name of file to be read + character(len=*), intent(in) :: varname !< Name of variable to be read + real, intent(out) :: var(:,:) !< Output array of variable + integer, optional, intent(in) :: start(:) !< Starting index on each axis. + integer, optional, intent(in) :: nread(:) !< Number of values to be read along each axis + integer, optional, intent(in) :: ncid_in !< netCDF ID of an opened file. + !! If absent, the file is opened and closed within this routine. + + integer :: ncid, varid, ndims, rc + character(len=*), parameter :: hdr = "read_variable_2d" + character(len=128) :: msg + logical :: size_mismatch + + if (is_root_pe()) then + if (present(ncid_in)) then + ncid = ncid_in + else + call open_file_to_Read(filename, ncid) + endif + + call get_varid(varname, ncid, filename, varid, match_case=.false.) + if (varid < 0) call MOM_error(FATAL, "Unable to get netCDF varid for "//trim(varname)//& + " in "//trim(filename)) + ! Verify that start(:) and nread(:) ranks match variable's dimension count + rc = nf90_inquire_variable(ncid, varid, ndims=ndims) + if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //& + " Difficulties reading "//trim(varname)//" from "//trim(filename)) + + size_mismatch = .false. + if (present(start)) size_mismatch = size_mismatch .or. size(start) /= ndims + if (present(nread)) size_mismatch = size_mismatch .or. size(nread) /= ndims + + if (size_mismatch) then + write (msg, '("'// hdr //': size(start) ", i0, " and/or size(nread) ", & + i0, " do not match ndims ", i0)') size(start), size(nread), ndims + call MOM_error(FATAL, trim(msg)) + endif + ! NOTE: We could check additional information here (type, size, ...) + + rc = nf90_get_var(ncid, varid, var, start, nread) + if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //& + " Difficulties reading "//trim(varname)//" from "//trim(filename)) + + if (.not.present(ncid_in)) call close_file_to_read(ncid, filename) + endif + + call broadcast(var, size(var), blocking=.true.) +end subroutine read_variable_2d + !> Read a character-string global or variable attribute subroutine read_attribute_str(filename, attname, att_val, varname, found, all_read, ncid_in) character(len=*), intent(in) :: filename !< Name of the file to read @@ -1542,6 +1604,32 @@ subroutine delete_axis_info(axes) enddo end subroutine delete_axis_info + +!> Retrieve the information from an axis_info type. +subroutine get_axis_info(axis,name,longname,units,cartesian,ax_size,ax_data) + type(axis_info), intent(in) :: axis !< An axis type + character(len=*), intent(out), optional :: name !< The axis name. + character(len=*), intent(out), optional :: longname !< The axis longname. + character(len=*), intent(out), optional :: units !< The axis units. + character(len=*), intent(out), optional :: cartesian !< The cartesian attribute + !! of the axis [X,Y,Z,T]. + integer, intent(out), optional :: ax_size !< The size of the axis. + real, optional, allocatable, dimension(:), intent(out) :: ax_data !< The axis label data. + + if (present(ax_data)) then + if (allocated(ax_data)) deallocate(ax_data) + allocate(ax_data(axis%ax_size)) + ax_data(:)=axis%ax_data + endif + + if (present(name)) name=axis%name + if (present(longname)) longname=axis%longname + if (present(units)) units=axis%units + if (present(cartesian)) cartesian=axis%cartesian + if (present(ax_size)) ax_size=axis%ax_size + +end subroutine get_axis_info + !> Store information that can be used to create an attribute in a subsequent call to create_file. subroutine set_attribute_info(attribute, name, str_value) type(attribute_info), intent(inout) :: attribute !< A type with information about a named attribute @@ -2233,7 +2321,80 @@ subroutine MOM_io_init(param_file) call log_version(param_file, mdl, version) end subroutine MOM_io_init - +!> Returns the dimension variable information for a netCDF variable +subroutine get_var_axes_info(filename, fieldname, axes_info) + character(len=*), intent(in) :: filename !< A filename from which to read + character(len=*), intent(in) :: fieldname !< The name of the field to read + type(axis_info), dimension(4), intent(inout) :: axes_info !< A returned array of field axis information + + !! local variables + integer :: rcode + logical :: success + integer :: ncid, varid, ndims + integer :: id, jd, kd + integer, dimension(4) :: dims, dim_id + real :: missing_value + character(len=128) :: dim_name(4) + integer, dimension(1) :: start, count + !! cartesian axis data + real, allocatable, dimension(:) :: x + real, allocatable, dimension(:) :: y + real, allocatable, dimension(:) :: z + + + call open_file_to_read(filename, ncid, success=success) + + rcode = NF90_INQ_VARID(ncid, trim(fieldname), varid) + if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(fieldname)//& + " in file "//trim(filename)//" in hinterp_extrap") + + rcode = NF90_INQUIRE_VARIABLE(ncid, varid, ndims=ndims, dimids=dims) + if (rcode /= 0) call MOM_error(FATAL, "Error inquiring about the dimensions of "//trim(fieldname)//& + " in file "//trim(filename)//" in hinterp_extrap") + if (ndims < 3) call MOM_error(FATAL,"Variable "//trim(fieldname)//" in file "//trim(filename)// & + " has too few dimensions to be read as a 3-d array.") + rcode = NF90_INQUIRE_DIMENSION(ncid, dims(1), dim_name(1), len=id) + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 1 data for "// & + trim(fieldname)//" in file "// trim(filename)//" in hinterp_extrap") + rcode = NF90_INQ_VARID(ncid, dim_name(1), dim_id(1)) + if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(1))//& + " in file "//trim(filename)//" in hinterp_extrap") + rcode = NF90_INQUIRE_DIMENSION(ncid, dims(2), dim_name(2), len=jd) + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 2 data for "// & + trim(fieldname)//" in file "// trim(filename)//" in hinterp_extrap") + rcode = NF90_INQ_VARID(ncid, dim_name(2), dim_id(2)) + if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(2))//& + " in file "//trim(filename)//" in hinterp_extrap") + rcode = NF90_INQUIRE_DIMENSION(ncid, dims(3), dim_name(3), len=kd) + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 3 data for "// & + trim(fieldname)//" in file "// trim(filename)//" in hinterp_extrap") + rcode = NF90_INQ_VARID(ncid, dim_name(3), dim_id(3)) + if (rcode /= 0) call MOM_error(FATAL,"error finding variable "//trim(dim_name(3))//& + " in file "//trim(filename)//" in hinterp_extrap") + allocate(x(id), y(jd), z(kd)) + + start = 1 ; count = 1 ; count(1) = id + rcode = NF90_GET_VAR(ncid, dim_id(1), x, start, count) + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 1 values for var_name "// & + trim(fieldname)//",dim_name "//trim(dim_name(1))//" in file "// trim(filename)//" in hinterp_extrap") + start = 1 ; count = 1 ; count(1) = jd + rcode = NF90_GET_VAR(ncid, dim_id(2), y, start, count) + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 2 values for var_name "// & + trim(fieldname)//",dim_name "//trim(dim_name(2))//" in file "// trim(filename)//" in hinterp_extrap") + start = 1 ; count = 1 ; count(1) = kd + rcode = NF90_GET_VAR(ncid, dim_id(3), z, start, count) + if (rcode /= 0) call MOM_error(FATAL,"error reading dimension 3 values for var_name "// & + trim(fieldname//",dim_name "//trim(dim_name(3)))//" in file "// trim(filename)//" in hinterp_extrap") + + call set_axis_info(axes_info(1), name=trim(dim_name(1)), ax_size=id, ax_data=x,cartesian='X') + call set_axis_info(axes_info(2), name=trim(dim_name(2)), ax_size=jd, ax_data=y,cartesian='Y') + call set_axis_info(axes_info(3), name=trim(dim_name(3)), ax_size=kd, ax_data=z,cartesian='Z') + + call close_file_to_read(ncid, filename) + + deallocate(x,y,z) + +end subroutine get_var_axes_info !> \namespace mom_io !! !! This file contains a number of subroutines that manipulate From d838ccd800676990aa5718043200336388f51d82 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Jan 2022 09:13:24 -0500 Subject: [PATCH 46/73] Clean up non-standard syntax and whitespace Eliminated a number of instances of non-standard syntax from that described in https://github.com/NOAA-GFDL/MOM6/wiki/Code-style-guide. The changes include enforcing the MOM6-standard 2-point indentation convention, replacing 'if(A)' with 'if (A)', and changing logical comparison syntax like '.gt.' to '>' or '.eq.' to '=='. An old commented out block of code for debugging (detected by its use of non-standard syntax) was also eliminated. All answers and output are bitwise identical. --- src/ALE/MOM_ALE.F90 | 4 +- src/core/MOM.F90 | 12 +-- src/core/MOM_continuity_PPM.F90 | 2 +- src/core/MOM_dynamics_split_RK2.F90 | 18 ++-- src/core/MOM_dynamics_unsplit.F90 | 23 +++-- src/core/MOM_dynamics_unsplit_RK2.F90 | 20 ++-- src/core/MOM_open_boundary.F90 | 8 +- src/core/MOM_variables.F90 | 8 +- src/framework/MOM_checksums.F90 | 20 ++-- src/framework/MOM_document.F90 | 18 ++-- src/framework/MOM_io.F90 | 16 +-- src/framework/MOM_random.F90 | 10 +- src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 | 8 +- src/ocean_data_assim/MOM_oda_driver.F90 | 98 +++++++++---------- .../lateral/MOM_internal_tides.F90 | 4 +- .../lateral/MOM_tidal_forcing.F90 | 2 +- .../vertical/MOM_CVMix_KPP.F90 | 2 +- .../vertical/MOM_energetic_PBL.F90 | 5 +- .../vertical/MOM_tidal_mixing.F90 | 27 ++--- src/tracer/MOM_lateral_boundary_diffusion.F90 | 14 +-- 20 files changed, 150 insertions(+), 169 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 9aa01738b6..41ee555c52 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -869,7 +869,7 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i+1,j,:) ) endif if (associated(OBC)) then - if (OBC%segnum_u(I,j) .ne. 0) then + if (OBC%segnum_u(I,j) /= 0) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then h1(:) = h_old(i,j,:) h2(:) = h_new(i,j,:) @@ -902,7 +902,7 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i,j+1,:) ) endif if (associated(OBC)) then - if (OBC%segnum_v(i,J) .ne. 0) then + if (OBC%segnum_v(i,J) /= 0) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then h1(:) = h_old(i,j,:) h2(:) = h_new(i,j,:) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 7a15d58bb1..c36c0545e1 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1138,11 +1138,9 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & endif ! -------------------------------------------------- end SPLIT - if (CS%do_dynamics) then!run particles whether or not stepping is split - if (CS%use_particles) then - call particles_run(CS%particles, Time_local, CS%u, CS%v, CS%h, CS%tv) ! Run the particles model - endif - endif + if (CS%use_particles .and. CS%do_dynamics) then ! Run particles whether or not stepping is split + call particles_run(CS%particles, Time_local, CS%u, CS%v, CS%h, CS%tv) ! Run the particles model + endif if (CS%thickness_diffuse .and. .not.CS%thickness_diffuse_first) then @@ -3721,8 +3719,8 @@ subroutine MOM_end(CS) endif if (CS%use_particles) then - call particles_end(CS%particles) - deallocate(CS%particles) + call particles_end(CS%particles) + deallocate(CS%particles) endif call thickness_diffuse_end(CS%thickness_diffuse_CSp, CS%CDp) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 95de2fd923..e5bd2f9ae9 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -1282,7 +1282,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, por_fac l_seg = OBC%segnum_v(i,J) do_I(I) = .false. - if(l_seg /= OBC_NONE) & + if (l_seg /= OBC_NONE) & do_I(i) = (OBC%segment(l_seg)%specified) if (do_I(i)) FAvi(i) = GV%H_subroundoff*G%dx_Cv(i,J) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 68b844562f..f22fb9a862 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -1368,12 +1368,12 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_h_PFu = register_diag_field('ocean_model', 'h_PFu', diag%axesCuL, Time, & 'Thickness Multiplied Zonal Pressure Force Acceleration', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_PFu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) + if (CS%id_h_PFu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) CS%id_h_PFv = register_diag_field('ocean_model', 'h_PFv', diag%axesCvL, Time, & 'Thickness Multiplied Meridional Pressure Force Acceleration', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_PFv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) + if (CS%id_h_PFv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_intz_PFu_2d = register_diag_field('ocean_model', 'intz_PFu_2d', diag%axesCu1, Time, & 'Depth-integral of Zonal Pressure Force Acceleration', & @@ -1398,12 +1398,12 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_h_CAu = register_diag_field('ocean_model', 'h_CAu', diag%axesCuL, Time, & 'Thickness Multiplied Zonal Coriolis and Advective Acceleration', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_CAu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) + if (CS%id_h_CAu > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) CS%id_h_CAv = register_diag_field('ocean_model', 'h_CAv', diag%axesCvL, Time, & 'Thickness Multiplied Meridional Coriolis and Advective Acceleration', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_CAv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) + if (CS%id_h_CAv > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_intz_CAu_2d = register_diag_field('ocean_model', 'intz_CAu_2d', diag%axesCu1, Time, & 'Depth-integral of Zonal Coriolis and Advective Acceleration', & @@ -1448,12 +1448,12 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_h_u_BT_accel = register_diag_field('ocean_model', 'h_u_BT_accel', diag%axesCuL, Time, & 'Thickness Multiplied Barotropic Anomaly Zonal Acceleration', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_u_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) + if (CS%id_h_u_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hu,IsdB,IedB,jsd,jed,nz) CS%id_h_v_BT_accel = register_diag_field('ocean_model', 'h_v_BT_accel', diag%axesCvL, Time, & 'Thickness Multiplied Barotropic Anomaly Meridional Acceleration', & 'm2 s-2', conversion=GV%H_to_m*US%L_T2_to_m_s2) - if(CS%id_h_v_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) + if (CS%id_h_v_BT_accel > 0) call safe_alloc_ptr(CS%ADp%diag_hv,isd,ied,JsdB,JedB,nz) CS%id_intz_u_BT_accel_2d = register_diag_field('ocean_model', 'intz_u_BT_accel_2d', diag%axesCu1, Time, & 'Depth-integral of Barotropic Anomaly Zonal Acceleration', & @@ -1472,7 +1472,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_PFv_visc_rem = register_diag_field('ocean_model', 'PFv_visc_rem', diag%axesCvL, Time, & 'Meridional Pressure Force Acceleration multiplied by the viscous remnant', & 'm s-2', conversion=US%L_T2_to_m_s2) - if(CS%id_PFv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + if (CS%id_PFv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) CS%id_CAu_visc_rem = register_diag_field('ocean_model', 'CAu_visc_rem', diag%axesCuL, Time, & 'Zonal Coriolis and Advective Acceleration multiplied by the viscous remnant', & @@ -1481,7 +1481,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_CAv_visc_rem = register_diag_field('ocean_model', 'CAv_visc_rem', diag%axesCvL, Time, & 'Meridional Coriolis and Advective Acceleration multiplied by the viscous remnant', & 'm s-2', conversion=US%L_T2_to_m_s2) - if(CS%id_CAv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + if (CS%id_CAv_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) CS%id_u_BT_accel_visc_rem = register_diag_field('ocean_model', 'u_BT_accel_visc_rem', diag%axesCuL, Time, & 'Barotropic Anomaly Zonal Acceleration multiplied by the viscous remnant', & @@ -1490,7 +1490,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%id_v_BT_accel_visc_rem = register_diag_field('ocean_model', 'v_BT_accel_visc_rem', diag%axesCvL, Time, & 'Barotropic Anomaly Meridional Acceleration multiplied by the viscous remnant', & 'm s-2', conversion=US%L_T2_to_m_s2) - if(CS%id_v_BT_accel_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) + if (CS%id_v_BT_accel_visc_rem > 0) call safe_alloc_ptr(CS%ADp%visc_rem_v,isd,ied,JsdB,JedB,nz) id_clock_Cor = cpu_clock_id('(Ocean Coriolis & mom advection)', grain=CLOCK_MODULE) id_clock_continuity = cpu_clock_id('(Ocean continuity equation)', grain=CLOCK_MODULE) diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index fcc4c3d49b..9a58dddd0f 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -239,8 +239,6 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0; upp(:,:,:) = 0 vp(:,:,:) = 0; vpp(:,:,:) = 0 - if (CS%id_ueffA > 0) ueffA(:,:,:) = 0 - if (CS%id_veffA > 0) veffA(:,:,:) = 0 dyn_p_surf = associated(p_surf_begin) .and. associated(p_surf_end) if (dyn_p_surf) then @@ -431,22 +429,23 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & call disable_averaging(CS%diag) call enable_averages(dt, Time_local, CS%diag) -! Calculate effective areas and post data + ! Calculate effective areas and post data if (CS%id_ueffA > 0) then - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_ueffA, ueffA, CS%diag) + ueffA(:,:,:) = 0 + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_ueffA, ueffA, CS%diag) endif if (CS%id_veffA > 0) then - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_veffA, veffA, CS%diag) + veffA(:,:,:) = 0 + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_veffA, veffA, CS%diag) endif - ! h_av = (h + hp)/2 do k=1,nz do j=js-2,je+2 ; do i=is-2,ie+2 diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 694d88f2ea..ec4a1aa843 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -250,8 +250,6 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, h_av(:,:,:) = 0; hp(:,:,:) = 0 up(:,:,:) = 0 vp(:,:,:) = 0 - if (CS%id_ueffA > 0) ueffA(:,:,:) = 0 - if (CS%id_veffA > 0) veffA(:,:,:) = 0 dyn_p_surf = associated(p_surf_begin) .and. associated(p_surf_end) if (dyn_p_surf) then @@ -452,17 +450,19 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, ! Calculate effective areas and post data if (CS%id_ueffA > 0) then - do k=1,nz ; do j=js,je ; do I=Isq,Ieq - if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) - enddo ; enddo ; enddo - call post_data(CS%id_ueffA, ueffA, CS%diag) + ueffA(:,:,:) = 0 + do k=1,nz ; do j=js,je ; do I=Isq,Ieq + if (abs(up(I,j,k)) > 0.) ueffA(I,j,k) = uh(I,j,k)/up(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_ueffA, ueffA, CS%diag) endif if (CS%id_veffA > 0) then - do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie - if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) - enddo ; enddo ; enddo - call post_data(CS%id_veffA, veffA, CS%diag) + veffA(:,:,:) = 0 + do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie + if (abs(vp(i,J,k)) > 0.) veffA(i,J,k) = vh(i,J,k)/vp(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_veffA, veffA, CS%diag) endif diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 2c3f016005..41ba70f152 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -859,7 +859,7 @@ subroutine initialize_segment_data(G, OBC, PF) ! siz(3) is constituent for tidal variables call field_size(filename, 'constituent', siz, no_domain=.true.) ! expect third dimension to be number of constituents in MOM_input - if (siz(3) .ne. OBC%n_tide_constituents .and. OBC%add_tide_constituents) then + if (siz(3) /= OBC%n_tide_constituents .and. OBC%add_tide_constituents) then call MOM_error(FATAL, 'Number of constituents in input data is not '//& 'the same as the number specified') endif @@ -897,7 +897,7 @@ subroutine initialize_segment_data(G, OBC, PF) ! Check if this is a tidal field. If so, the number ! of expected constituents must be 1. if ((index(segment%field(m)%name, 'phase') > 0) .or. (index(segment%field(m)%name, 'amp') > 0)) then - if (OBC%n_tide_constituents .gt. 1 .and. OBC%add_tide_constituents) then + if (OBC%n_tide_constituents > 1 .and. OBC%add_tide_constituents) then call MOM_error(FATAL, 'Only one constituent is supported when specifying '//& 'tidal boundary conditions by value rather than file.') endif @@ -997,7 +997,7 @@ subroutine initialize_obc_tides(OBC, US, param_file) ! If the nodal correction is based on a different time, initialize that. ! Otherwise, it can use N from the time reference. if (OBC%add_nodal_terms) then - if (sum(nodal_ref_date) .ne. 0) then + if (sum(nodal_ref_date) /= 0) then ! A reference date was provided for the nodal correction nodal_time = set_date(nodal_ref_date(1), nodal_ref_date(2), nodal_ref_date(3)) call astro_longitudes_init(nodal_time, nodal_longitudes) @@ -3939,7 +3939,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) endif ! no dz for tidal variables if (segment%field(m)%nk_src > 1 .and.& - (index(segment%field(m)%name, 'phase') .le. 0 .and. index(segment%field(m)%name, 'amp') .le. 0)) then + (index(segment%field(m)%name, 'phase') <= 0 .and. index(segment%field(m)%name, 'amp') <= 0)) then call time_interp_external(segment%field(m)%fid_dz,Time, tmp_buffer_in) if (turns /= 0) then ! TODO: This is hardcoded for 90 degrees, and needs to be generalized. diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index ba5001e427..a9bf6c3dcf 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -316,10 +316,10 @@ module MOM_variables !> pointers to grids modifying cell metric at porous barriers type, public :: porous_barrier_ptrs - real, pointer, dimension(:,:,:) :: por_face_areaU => NULL() !< fractional open area of U-faces [nondim] - real, pointer, dimension(:,:,:) :: por_face_areaV => NULL() !< fractional open area of V-faces [nondim] - real, pointer, dimension(:,:,:) :: por_layer_widthU => NULL() !< fractional open width of U-faces [nondim] - real, pointer, dimension(:,:,:) :: por_layer_widthV => NULL() !< fractional open width of V-faces [nondim] + real, pointer, dimension(:,:,:) :: por_face_areaU => NULL() !< fractional open area of U-faces [nondim] + real, pointer, dimension(:,:,:) :: por_face_areaV => NULL() !< fractional open area of V-faces [nondim] + real, pointer, dimension(:,:,:) :: por_layer_widthU => NULL() !< fractional open width of U-faces [nondim] + real, pointer, dimension(:,:,:) :: por_layer_widthV => NULL() !< fractional open width of V-faces [nondim] end type porous_barrier_ptrs diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index fffdb9bed8..d1a8102fc1 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -110,7 +110,7 @@ subroutine chksum0(scalar, mesg, scale, logunit) call chksum_error(FATAL, 'NaN detected: '//trim(mesg)) scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit if (calculateStatistics) then rs = scaling * scalar @@ -147,7 +147,7 @@ subroutine zchksum(array, mesg, scale, logunit) endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit if (calculateStatistics) then if (present(scale)) then @@ -352,7 +352,7 @@ subroutine chksum_h_2d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logu endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit if (calculateStatistics) then if (present(scale)) then @@ -618,7 +618,7 @@ subroutine chksum_B_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -901,7 +901,7 @@ subroutine chksum_u_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -1079,7 +1079,7 @@ subroutine chksum_v_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -1246,7 +1246,7 @@ subroutine chksum_h_3d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logu endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit if (calculateStatistics) then if (present(scale)) then @@ -1397,7 +1397,7 @@ subroutine chksum_B_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -1576,7 +1576,7 @@ subroutine chksum_u_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif @@ -1754,7 +1754,7 @@ subroutine chksum_v_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, endif scaling = 1.0 ; if (present(scale)) scaling = scale - iounit = error_unit; if(present(logunit)) iounit = logunit + iounit = error_unit ; if (present(logunit)) iounit = logunit sym_stats = .false. ; if (present(symmetric)) sym_stats = symmetric if (present(haloshift)) then ; if (haloshift > 0) sym_stats = .true. ; endif diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index ff0934ac55..24f77a0eb2 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -672,22 +672,22 @@ function real_array_string(vals, sep) integer :: j, n, ns logical :: doWrite character(len=10) :: separator - n=1 ; doWrite=.true. ; real_array_string='' + n = 1 ; doWrite = .true. ; real_array_string = '' if (present(sep)) then - separator=sep ; ns=len(sep) + separator = sep ; ns = len(sep) else - separator=', ' ; ns=2 + separator = ', ' ; ns = 2 endif do j=1,size(vals) - doWrite=.true. - if (j0) then ! Write separator if a number has already been written + if (len(real_array_string) > 0) then ! Write separator if a number has already been written real_array_string = real_array_string // separator(1:ns) endif if (n>1) then diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 2b8fb210d5..2ea19df183 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -1617,16 +1617,16 @@ subroutine get_axis_info(axis,name,longname,units,cartesian,ax_size,ax_data) real, optional, allocatable, dimension(:), intent(out) :: ax_data !< The axis label data. if (present(ax_data)) then - if (allocated(ax_data)) deallocate(ax_data) - allocate(ax_data(axis%ax_size)) - ax_data(:)=axis%ax_data + if (allocated(ax_data)) deallocate(ax_data) + allocate(ax_data(axis%ax_size)) + ax_data(:) = axis%ax_data endif - if (present(name)) name=axis%name - if (present(longname)) longname=axis%longname - if (present(units)) units=axis%units - if (present(cartesian)) cartesian=axis%cartesian - if (present(ax_size)) ax_size=axis%ax_size + if (present(name)) name = axis%name + if (present(longname)) longname = axis%longname + if (present(units)) units = axis%units + if (present(cartesian)) cartesian = axis%cartesian + if (present(ax_size)) ax_size = axis%ax_size end subroutine get_axis_info diff --git a/src/framework/MOM_random.F90 b/src/framework/MOM_random.F90 index 709fd27731..bef78a433a 100644 --- a/src/framework/MOM_random.F90 +++ b/src/framework/MOM_random.F90 @@ -223,9 +223,9 @@ function new_RandomNumberSequence(seed) result(twister) twister%state(0) = iand(seed, -1) do i = 1, blockSize - 1 ! ubound(twister%state) - twister%state(i) = 1812433253 * ieor(twister%state(i-1), & - ishft(twister%state(i-1), -30)) + i - twister%state(i) = iand(twister%state(i), -1) ! for >32 bit machines + twister%state(i) = 1812433253 * ieor(twister%state(i-1), & + ishft(twister%state(i-1), -30)) + i + twister%state(i) = iand(twister%state(i), -1) ! for >32 bit machines end do twister%currentElement = blockSize end function new_RandomNumberSequence @@ -236,7 +236,7 @@ end function new_RandomNumberSequence integer function getRandomInt(twister) type(randomNumberSequence), intent(inout) :: twister !< The Mersenne Twister container - if(twister%currentElement >= blockSize) call nextState(twister) + if (twister%currentElement >= blockSize) call nextState(twister) getRandomInt = temper(twister%state(twister%currentElement)) twister%currentElement = twister%currentElement + 1 @@ -251,7 +251,7 @@ double precision function getRandomReal(twister) integer :: localInt localInt = getRandomInt(twister) - if(localInt < 0) then + if (localInt < 0) then getRandomReal = dble(localInt + 2.0d0**32)/(2.0d0**32 - 1.0d0) else getRandomReal = dble(localInt )/(2.0d0**32 - 1.0d0) diff --git a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 index 2a3066dfbd..ef4ad7b6d9 100644 --- a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 +++ b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 @@ -448,7 +448,7 @@ function register_MOM_IS_diag_field(module_name, field_name, axes, init_time, & type(diag_type), pointer :: diag => NULL() MOM_missing_value = axes%diag_cs%missing_value - if(present(missing_value)) MOM_missing_value = missing_value + if (present(missing_value)) MOM_missing_value = missing_value diag_cs => axes%diag_cs primary_id = -1 @@ -537,7 +537,7 @@ integer function register_MOM_IS_static_field(module_name, field_name, axes, & type(diag_ctrl), pointer :: diag_cs !< A structure that is used to regulate diagnostic output MOM_missing_value = axes%diag_cs%missing_value - if(present(missing_value)) MOM_missing_value = missing_value + if (present(missing_value)) MOM_missing_value = missing_value diag_cs => axes%diag_cs primary_id = -1 @@ -582,8 +582,8 @@ function i2s(a, n_in) character(len=15) :: i2s_temp integer :: i,n - n=size(a) - if(present(n_in)) n = n_in + n = size(a) + if (present(n_in)) n = n_in i2s = '' do i=1,n diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index d5259d760a..f183231c88 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -79,9 +79,9 @@ module MOM_oda_driver_mod !> A structure containing integer handles for bias adjustment of tracers type :: INC_CS - integer :: fldno = 0 !< The number of tracers - integer :: T_id !< The integer handle for the temperature file - integer :: S_id !< The integer handle for the salinity file + integer :: fldno = 0 !< The number of tracers + integer :: T_id !< The integer handle for the temperature file + integer :: S_id !< The integer handle for the salinity file end type INC_CS !> Control structure that contains a transpose of the ocean state across ensemble members. @@ -353,21 +353,21 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) call set_PElist(CS%ensemble_pelist(CS%ensemble_id,:)) if (CS%do_bias_adjustment) then - call get_param(PF, mdl, "TEMP_SALT_ADJUSTMENT_FILE", bias_correction_file, & - "The name of the file containing temperature and salinity "//& - "tendency adjustments", default='temp_salt_adjustment.nc') + call get_param(PF, mdl, "TEMP_SALT_ADJUSTMENT_FILE", bias_correction_file, & + "The name of the file containing temperature and salinity "//& + "tendency adjustments", default='temp_salt_adjustment.nc') - inc_file = trim(inputdir) // trim(bias_correction_file) - CS%INC_CS%T_id = init_extern_field(inc_file, "temp_increment", & + inc_file = trim(inputdir) // trim(bias_correction_file) + CS%INC_CS%T_id = init_extern_field(inc_file, "temp_increment", & correct_leap_year_inconsistency=.true.,verbose=.true.,domain=G%Domain%mpp_domain) - CS%INC_CS%S_id = init_extern_field(inc_file, "salt_increment", & + CS%INC_CS%S_id = init_extern_field(inc_file, "salt_increment", & correct_leap_year_inconsistency=.true.,verbose=.true.,domain=G%Domain%mpp_domain) - call get_external_field_info(CS%INC_CS%T_id,size=fld_sz) - CS%INC_CS%fldno = 2 - if (CS%nk .ne. fld_sz(3)) call MOM_error(FATAL,'Increment levels /= ODA levels') - allocate(CS%tv_bc) ! storage for increment - allocate(CS%tv_bc%T(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) - allocate(CS%tv_bc%S(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) + call get_external_field_info(CS%INC_CS%T_id,size=fld_sz) + CS%INC_CS%fldno = 2 + if (CS%nk /= fld_sz(3)) call MOM_error(FATAL,'Increment levels /= ODA levels') + allocate(CS%tv_bc) ! storage for increment + allocate(CS%tv_bc%T(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) + allocate(CS%tv_bc%S(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) endif call cpu_clock_end(id_clock_oda_init) @@ -455,7 +455,7 @@ subroutine get_posterior_tracer(Time, CS, h, tv, increment) integer :: seconds_per_hour = 3600. ! return if not analysis time (retain pointers for h and tv) - if (Time < CS%Time .or. CS%assim_method .eq. NO_ASSIM) return + if (Time < CS%Time .or. CS%assim_method == NO_ASSIM) return !! switch to global pelist @@ -531,43 +531,43 @@ subroutine oda(Time, CS) end subroutine oda subroutine get_bias_correction_tracer(Time, CS) - type(time_type), intent(in) :: Time !< the current model time - type(ODA_CS), pointer :: CS !< ocean DA control structure - - integer :: i,j,k - real, allocatable, dimension(:,:,:) :: T_bias, S_bias - real, allocatable, dimension(:,:,:) :: mask_z - real, allocatable, dimension(:), target :: z_in, z_edges_in - real :: missing_value - integer,dimension(3) :: fld_sz - - call cpu_clock_begin(id_clock_bias_adjustment) - call horiz_interp_and_extrap_tracer(CS%INC_CS%T_id,Time,1.0,CS%G,T_bias,& - mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) - call horiz_interp_and_extrap_tracer(CS%INC_CS%S_id,Time,1.0,CS%G,S_bias,& - mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) - - ! This should be replaced to use mask_z instead of the following lines - ! which are intended to zero land values using an arbitrary limit. - fld_sz=shape(T_bias) - do i=1,fld_sz(1) - do j=1,fld_sz(2) - do k=1,fld_sz(3) - if (T_bias(i,j,k) .gt. 1.0E-3) T_bias(i,j,k) = 0.0 - if (S_bias(i,j,k) .gt. 1.0E-3) S_bias(i,j,k) = 0.0 - enddo - enddo + type(time_type), intent(in) :: Time !< the current model time + type(ODA_CS), pointer :: CS !< ocean DA control structure + + integer :: i,j,k + real, allocatable, dimension(:,:,:) :: T_bias, S_bias + real, allocatable, dimension(:,:,:) :: mask_z + real, allocatable, dimension(:), target :: z_in, z_edges_in + real :: missing_value + integer,dimension(3) :: fld_sz + + call cpu_clock_begin(id_clock_bias_adjustment) + call horiz_interp_and_extrap_tracer(CS%INC_CS%T_id,Time,1.0,CS%G,T_bias,& + mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) + call horiz_interp_and_extrap_tracer(CS%INC_CS%S_id,Time,1.0,CS%G,S_bias,& + mask_z,z_in,z_edges_in,missing_value,.true.,.false.,.false.,.true.) + + ! This should be replaced to use mask_z instead of the following lines + ! which are intended to zero land values using an arbitrary limit. + fld_sz=shape(T_bias) + do i=1,fld_sz(1) + do j=1,fld_sz(2) + do k=1,fld_sz(3) + if (T_bias(i,j,k) > 1.0E-3) T_bias(i,j,k) = 0.0 + if (S_bias(i,j,k) > 1.0E-3) S_bias(i,j,k) = 0.0 + enddo enddo + enddo - CS%tv_bc%T = T_bias * CS%bias_adjustment_multiplier - CS%tv_bc%S = S_bias * CS%bias_adjustment_multiplier + CS%tv_bc%T = T_bias * CS%bias_adjustment_multiplier + CS%tv_bc%S = S_bias * CS%bias_adjustment_multiplier - call pass_var(CS%tv_bc%T, CS%domains(CS%ensemble_id)) - call pass_var(CS%tv_bc%S, CS%domains(CS%ensemble_id)) + call pass_var(CS%tv_bc%T, CS%domains(CS%ensemble_id)) + call pass_var(CS%tv_bc%S, CS%domains(CS%ensemble_id)) - call cpu_clock_end(id_clock_bias_adjustment) + call cpu_clock_end(id_clock_bias_adjustment) - end subroutine get_bias_correction_tracer +end subroutine get_bias_correction_tracer !> Finalize DA module subroutine oda_end(CS) @@ -655,7 +655,7 @@ subroutine apply_oda_tracer_increments(dt, Time_end, G, GV, tv, h, CS) real :: missing_value if (.not. associated(CS)) return - if (CS%assim_method .eq. NO_ASSIM .and. (.not. CS%do_bias_adjustment)) return + if (CS%assim_method == NO_ASSIM .and. (.not. CS%do_bias_adjustment)) return call cpu_clock_begin(id_clock_apply_increments) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index eb7d3a6340..dfbb3e0d63 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -1696,13 +1696,13 @@ subroutine reflect(En, NAngle, CS, G, LB) if (ridge(i,j)) then ! if ray is not incident but in ridge cell, use complementary angle - if ((Nangle_d2 .lt. angle_to_wall) .and. (angle_to_wall .lt. Nangle)) then + if ((Nangle_d2 < angle_to_wall) .and. (angle_to_wall < Nangle)) then angle_wall0 = mod(angle_wall0 + Nangle_d2 + Nangle, Nangle) endif endif ! do reflection - if ((0 .lt. angle_to_wall) .and. (angle_to_wall .lt. Nangle_d2)) then + if ((0 < angle_to_wall) .and. (angle_to_wall < Nangle_d2)) then angle_r0 = mod(2*angle_wall0 - a0 + Nangle, Nangle) angle_r = angle_r0 + 1 !re-index to 1 -> Nangle if (a /= angle_r) then diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index cc4517a473..f1d6e6bb57 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -388,7 +388,7 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS) if (sum(tide_ref_date) == 0) then ! tide_ref_date defaults to 0. CS%time_ref = set_date(1, 1, 1) else - if(.not. CS%use_eq_phase) then + if (.not. CS%use_eq_phase) then ! Using a reference date but not using phase relative to equilibrium. ! This makes sense as long as either phases are overridden, or ! correctly simulating tidal phases is not desired. diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 2ff0a21196..d12d850a73 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -1213,7 +1213,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl endif ! apply some constraints on OBLdepth - if(CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value + if (CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(GV%ke+1) ) ! no deeper than bottom CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index d88d5e551d..99dd38135d 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -916,11 +916,10 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs if (CS%TKE_diagnostics) & eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag if (present(epbl2_wt)) then ! perturb the TKE destruction - mech_TKE = mech_TKE * (1+(exp_kh-1) * epbl2_wt) + mech_TKE = mech_TKE * (1.0 + (exp_kh-1.0) * epbl2_wt) else - mech_TKE = mech_TKE * exp_kh + mech_TKE = mech_TKE * exp_kh endif - !if ( i .eq. 10 .and. j .eq. 10 .and. k .eq. nz) print*,'mech TKE', mech_TKE ! Accumulate any convectively released potential energy to contribute ! to wstar and to drive penetrating convection. diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index c8166c47b8..be574b4356 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -308,7 +308,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di endif ! CS%use_CVMix_tidal ! Read in vertical profile of tidal energy dissipation - if ( CS%CVMix_tidal_scheme.eq.SCHMITTNER .or. .not. CS%use_CVMix_tidal) then + if ( CS%CVMix_tidal_scheme == SCHMITTNER .or. .not. CS%use_CVMix_tidal) then call get_param(param_file, mdl, "INT_TIDE_PROFILE", int_tide_profile_str, & "INT_TIDE_PROFILE selects the vertical profile of energy "//& "dissipation with INT_TIDE_DISSIPATION. Valid values are:\n"//& @@ -562,8 +562,8 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di fail_if_missing=.true.) ! Check whether tidal energy input format and CVMix tidal mixing scheme are consistent if ( .not. ( & - (uppercase(tidal_energy_type(1:4)).eq.'JAYN' .and. CS%CVMix_tidal_scheme.eq.SIMMONS).or. & - (uppercase(tidal_energy_type(1:4)).eq.'ER03' .and. CS%CVMix_tidal_scheme.eq.SCHMITTNER) ) )then + (uppercase(tidal_energy_type(1:4)) == 'JAYN' .and. CS%CVMix_tidal_scheme == SIMMONS).or. & + (uppercase(tidal_energy_type(1:4)) == 'ER03' .and. CS%CVMix_tidal_scheme == SCHMITTNER) ) )then call MOM_error(FATAL, "tidal_mixing_init: Tidal energy file type ("//& trim(tidal_energy_type)//") is incompatible with CVMix tidal "//& " mixing scheme: "//trim(CVMix_tidal_scheme_str) ) @@ -1434,7 +1434,7 @@ subroutine setup_tidal_diagnostics(G, GV, CS) ! additional diags for CVMix if (CS%id_N2_int > 0) allocate(CS%dd%N2_int(isd:ied,jsd:jed,nz+1), source=0.0) if (CS%id_Simmons_coeff > 0) then - if (CS%CVMix_tidal_scheme .ne. SIMMONS) then + if (CS%CVMix_tidal_scheme /= SIMMONS) then call MOM_error(FATAL, "setup_tidal_diagnostics: Simmons_coeff diagnostics is available "//& "only when CVMix_tidal_scheme is Simmons") endif @@ -1442,14 +1442,14 @@ subroutine setup_tidal_diagnostics(G, GV, CS) endif if (CS%id_vert_dep > 0) allocate(CS%dd%vert_dep_3d(isd:ied,jsd:jed,nz+1), source=0.0) if (CS%id_Schmittner_coeff > 0) then - if (CS%CVMix_tidal_scheme .ne. SCHMITTNER) then + if (CS%CVMix_tidal_scheme /= SCHMITTNER) then call MOM_error(FATAL, "setup_tidal_diagnostics: Schmittner_coeff diagnostics is available "//& "only when CVMix_tidal_scheme is Schmittner.") endif allocate(CS%dd%Schmittner_coeff_3d(isd:ied,jsd:jed,nz), source=0.0) endif if (CS%id_tidal_qe_md > 0) then - if (CS%CVMix_tidal_scheme .ne. SCHMITTNER) then + if (CS%CVMix_tidal_scheme /= SCHMITTNER) then call MOM_error(FATAL, "setup_tidal_diagnostics: tidal_qe_md diagnostics is available "//& "only when CVMix_tidal_scheme is Schmittner.") endif @@ -1636,21 +1636,6 @@ subroutine read_tidal_constituents(G, US, tidal_energy_file, CS) enddo ; enddo enddo - !open(unit=1905,file="out_1905.txt",access="APPEND") - !do j=G%jsd,G%jed - ! do i=isd,ied - ! if ( i+G%idg_offset .eq. 90 .and. j+G%jdg_offset .eq. 126) then - ! write(1905,*) "-------------------------------------------" - ! do k=50,nz_in(1) - ! write(1905,*) i,j,k - ! write(1905,*) CS%tidal_qe_3d_in(i,j,k), tc_m2(i,j,k) - ! write(1905,*) z_t(k), G%bathyT(i,j)+G%Z_ref, z_w(k),CS%tidal_diss_lim_tc - ! end do - ! endif - ! enddo - !enddo - !close(1905) - ! test if qE is positive if (any(CS%tidal_qe_3d_in<0.0)) then call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d_in terms.") diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index c11bc9856c..4a98aa1934 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -643,7 +643,7 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ k_bot_diff = (k_bot_max - k_bot_min) ! tracer flux where the minimum BLD intersets layer - if ((CS%linear) .and. (k_bot_diff .gt. 1)) then + if ((CS%linear) .and. (k_bot_diff > 1)) then ! apply linear decay at the base of hbl do k = k_bot_min,1,-1 F_layer_z(k) = -(dz_top(k) * khtr_u) * (phi_R_z(k) - phi_L_z(k)) @@ -678,11 +678,11 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ ! ! TODO: GMM add option to apply linear decay ! k_top_max = MAX(k_top_L, k_top_R) ! ! make sure left and right k indices span same range -! if (k_top_max .ne. k_top_L) then +! if (k_top_max /= k_top_L) then ! k_top_L = k_top_max ! zeta_top_L = 1.0 ! endif -! if (k_top_max .ne. k_top_R) then +! if (k_top_max /= k_top_R) then ! k_top_R= k_top_max ! zeta_top_R = 1.0 ! endif @@ -1011,10 +1011,10 @@ logical function test_boundary_k_range(k_top, zeta_top, k_bot, zeta_bot, k_top_a character(len=80) :: test_name !< Name of the unit test logical :: verbose !< If true always print output - test_boundary_k_range = k_top .ne. k_top_ans - test_boundary_k_range = test_boundary_k_range .or. (zeta_top .ne. zeta_top_ans) - test_boundary_k_range = test_boundary_k_range .or. (k_bot .ne. k_bot_ans) - test_boundary_k_range = test_boundary_k_range .or. (zeta_bot .ne. zeta_bot_ans) + test_boundary_k_range = k_top /= k_top_ans + test_boundary_k_range = test_boundary_k_range .or. (zeta_top /= zeta_top_ans) + test_boundary_k_range = test_boundary_k_range .or. (k_bot /= k_bot_ans) + test_boundary_k_range = test_boundary_k_range .or. (zeta_bot /= zeta_bot_ans) if (test_boundary_k_range) write(stdout,*) "UNIT TEST FAILED: ", test_name if (test_boundary_k_range .or. verbose) then From 6da5c9b97632a0b9b9343d1b26e3b266fc3e62f2 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 8 Jan 2022 09:04:16 -0500 Subject: [PATCH 47/73] Standardize code in calc_sfc_displacement Slightly modified the recently added subroutine calc_sfc_displacement to document the units of its variables and to follow the MOM6 code standards from https://github.com/NOAA-GFDL/MOM6/wiki/Code-style-guide. The changes include white-space corrections, changing logical comparison syntax like '.gt.' to '>', and explicitly identifying where array syntax is used. All answers and output are bitwise identical. --- .../MOM_state_initialization.F90 | 44 +++++++++---------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index f95192f5f8..22892817e6 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1242,67 +1242,67 @@ subroutine calc_sfc_displacement(PF, G, GV, US, mass_shelf, tv, h) eta ! The free surface height that the model should use [Z ~> m]. ! temporary arrays real, dimension(SZK_(GV)) :: rho_col ! potential density in the column for use in ice - real, dimension(SZK_(GV)) :: rho_h ! potential density multiplied by thickness [R Z ~> kg m-2 ] + real, dimension(SZK_(GV)) :: rho_h ! potential density multiplied by thickness [R Z ~> kg m-2] real, dimension(SZK_(GV)) :: h_tmp ! temporary storage for thicknesses [H ~> m] real, dimension(SZK_(GV)) :: p_ref ! pressure for density [R Z ~> kg m-2] real, dimension(SZK_(GV)+1) :: ei_tmp, ei_orig ! temporary storage for interface positions [Z ~> m] - real :: z_top, z_col, mass_disp, residual, tol + real :: z_top ! An estimate of the height of the ice-ocean interface [Z ~> m] + real :: mass_disp ! The net mass of sea water that has been displaced by the shelf [R Z ~> kg m-2] + real :: residual ! The difference between the displaced ocean mass and the ice shelf + ! mass [R Z ~> kg m-2] + real :: tol ! The initialization tolerance for ice shelf initialization [Z ~> m] integer :: is, ie, js, je, k, nz, i, j, max_iter, iter is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - - tol = 0.001 ! The initialization tolerance for ice shelf initialization (m) call get_param(PF, mdl, "ICE_SHELF_INITIALIZATION_Z_TOLERANCE", tol, & "A initialization tolerance for the calculation of the static "// & "ice shelf displacement (m) using initial temperature and salinity profile.",& - default=tol, units="m", scale=US%m_to_Z) + default=0.001, units="m", scale=US%m_to_Z) max_iter = 1e3 call MOM_mesg("Started calculating initial interface position under ice shelf ") ! Convert thicknesses to interface heights. call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) - do j = js, je ; do i = is, ie + do j=js,je ; do i=is,ie iter = 1 z_top_shelf(i,j) = 0.0 p_ref(:) = tv%p_ref - if (G%mask2dT(i,j) .gt. 0. .and. mass_shelf(i,j) .gt. 0.) then + if ((G%mask2dT(i,j) > 0.) .and. (mass_shelf(i,j) > 0.)) then call calculate_density(tv%T(i,j,:), tv%S(i,j,:), P_Ref, rho_col, tv%eqn_of_state) - z_top = min(max(-1.0*mass_shelf(i,j)/rho_col(1),-G%bathyT(i,j)),0.) - h_tmp = 0.0 - z_col = 0.0 - ei_tmp(1:nz+1)=eta(i,j,1:nz+1) - ei_orig(1:nz+1)=eta(i,j,1:nz+1) + z_top = min(max(-1.0*mass_shelf(i,j)/rho_col(1), -G%bathyT(i,j)), 0.) + h_tmp(:) = 0.0 + ei_tmp(1:nz+1) = eta(i,j,1:nz+1) + ei_orig(1:nz+1) = eta(i,j,1:nz+1) do k=1,nz+1 - if (ei_tmp(k) tol) .and. (z_top > -G%bathyT(i,j)) .and. (iter < max_iter)) + z_top = min(max(z_top-(residual*0.5e-3), -G%bathyT(i,j)), 0.0) + h_tmp(:) = 0.0 ei_tmp(1:nz+1) = ei_orig(1:nz+1) do k=1,nz+1 - if (ei_tmp(k)= max_iter) call MOM_mesg("Warning: calc_sfc_displacement too many iterations.") z_top_shelf(i,j) = z_top endif - enddo; enddo + enddo ; enddo call MOM_mesg("Calling depress_surface ") call depress_surface(h, G, GV, US, PF, tv, just_read=.false.,z_top_shelf=z_top_shelf) call MOM_mesg("Finishing calling depress_surface ") From 9f0018fe304596b8b723b32b708cd6bbced50e65 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 18 Jan 2022 13:26:57 -0500 Subject: [PATCH 48/73] +(*)Change the remapping dzInterface argument sign Changed the name and sign convention for the dzInterface argument to remap_all_state_vars to reflect the convention used in the regridding code and to reflect the fact that this is always a vertical displacement. This change eliminates a subtle array-syntax whole-array multiplication (by -1.) in one call to remap_all_state_vars (this clearly violated MOM6 code standards), and it corrects an actual sign error that will change answers (perhaps from a state of catastrophic failure) in the code for the REGRID_ACCELERATE_INIT=True option if REMAP_UV_USING_OLD_ALG is also true and the initial velocities that are being remapped are non-zero. Also added comments describing the real variables inside of remap_all_state_vars to help clarify what they do. Fortunately the situation where answers change seems like a very uncommon combination of settings (it is possible that no one has ever tried this), and all answers in the MOM6-examples test suite are bitwise identical. --- src/ALE/MOM_ALE.F90 | 56 ++++++++++++++++++++++++--------------------- 1 file changed, 30 insertions(+), 26 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 41ee555c52..72afad16df 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -378,7 +378,7 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, OBC, dt, frac_shelf_h) call diag_update_remap_grids(CS%diag) endif ! Remap all variables from old grid h onto new grid h_new - call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_new, Reg, OBC, -dzRegrid, & + call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_new, Reg, OBC, dzRegrid, & u, v, CS%show_call_tree, dt ) if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_main)") @@ -732,10 +732,10 @@ end subroutine ALE_regrid_accelerated !! new grids. When velocity components need to be remapped, thicknesses at !! velocity points are taken to be arithmetic averages of tracer thicknesses. !! This routine is called during initialization of the model at time=0, to -!! remap initiali conditions to the model grid. It is also called during a +!! remap initial conditions to the model grid. It is also called during a !! time step to update the state. subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, OBC, & - dxInterface, u, v, debug, dt) + dzInterface, u, v, debug, dt) type(remapping_CS), intent(in) :: CS_remapping !< Remapping control structure type(ALE_CS), intent(in) :: CS_ALE !< ALE control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure @@ -747,7 +747,7 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ocean_OBC_type), pointer :: OBC !< Open boundary structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - optional, intent(in) :: dxInterface !< Change in interface position + optional, intent(in) :: dzInterface !< Change in interface position !! [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] @@ -755,29 +755,34 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, optional, intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] logical, optional, intent(in) :: debug !< If true, show the call tree real, optional, intent(in) :: dt !< time step for diagnostics [T ~> s] + ! Local variables - integer :: i, j, k, m - integer :: nz, ntr - real, dimension(GV%ke+1) :: dx - real, dimension(GV%ke) :: h1, u_column - real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: work_conc - real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: work_cont - real, dimension(SZI_(G), SZJ_(G)) :: work_2d - real :: Idt ! The inverse of the timestep [T-1 ~> s-1] - real :: ppt2mks - real, dimension(GV%ke) :: h2 - real :: h_neglect, h_neglect_edge + real, dimension(GV%ke+1) :: dz ! The change in interface heights interpolated to + ! a velocity point [H ~> m or kg m-2] + real, dimension(GV%ke) :: h1 ! A column of initial thicknesses [H ~> m or kg m-2] + real, dimension(GV%ke) :: h2 ! A column of updated thicknesses [H ~> m or kg m-2] + real, dimension(GV%ke) :: u_column ! A column of properties, like tracer concentrations + ! or velocities, being remapped [various units] + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: work_conc ! The rate of change of concentrations [Conc T-1 ~> Conc s-1] + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: work_cont ! The rate of change of cell-integrated tracer + ! content [Conc H T-1 ~> Conc m s-1 or Conc kg m-2 s-1] or + ! cell thickness [H T-1 ~> m s-1 or Conc kg m-2 s-1] + real, dimension(SZI_(G), SZJ_(G)) :: work_2d ! The rate of change of column-integrated tracer + ! content [Conc H T-1 ~> Conc m s-1 or Conc kg m-2 s-1] + real :: Idt ! The inverse of the timestep [T-1 ~> s-1] + real :: h_neglect, h_neglect_edge ! Tiny thicknesses used in remapping [H ~> m or kg m-2] logical :: show_call_tree type(tracer_type), pointer :: Tr => NULL() + integer :: i, j, k, m, nz, ntr show_call_tree = .false. if (present(debug)) show_call_tree = debug if (show_call_tree) call callTree_enter("remap_all_state_vars(), MOM_ALE.F90") - ! If remap_uv_using_old_alg is .true. and u or v is requested, then we must have dxInterface. Otherwise, - ! u and v can be remapped without dxInterface - if ( .not. present(dxInterface) .and. (CS_ALE%remap_uv_using_old_alg .and. (present(u) .or. present(v))) ) then - call MOM_error(FATAL, "remap_all_state_vars: dxInterface must be present if using old algorithm "// & + ! If remap_uv_using_old_alg is .true. and u or v is requested, then we must have dzInterface. Otherwise, + ! u and v can be remapped without dzInterface + if ( .not. present(dzInterface) .and. (CS_ALE%remap_uv_using_old_alg .and. (present(u) .or. present(v))) ) then + call MOM_error(FATAL, "remap_all_state_vars: dzInterface must be present if using old algorithm "// & "and u/v are to be remapped") endif @@ -790,7 +795,6 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, endif nz = GV%ke - ppt2mks = 0.001 ntr = 0 ; if (associated(Reg)) ntr = Reg%ntr @@ -856,14 +860,14 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, ! Remap u velocity component if ( present(u) ) then - !$OMP parallel do default(shared) private(h1,h2,dx,u_column) + !$OMP parallel do default(shared) private(h1,h2,dz,u_column) do j = G%jsc,G%jec ; do I = G%iscB,G%iecB ; if (G%mask2dCu(I,j)>0.) then ! Build the start and final grids h1(:) = 0.5 * ( h_old(i,j,:) + h_old(i+1,j,:) ) if (CS_ALE%remap_uv_using_old_alg) then - dx(:) = 0.5 * ( dxInterface(i,j,:) + dxInterface(i+1,j,:) ) + dz(:) = 0.5 * ( dzInterface(i,j,:) + dzInterface(i+1,j,:) ) do k = 1, nz - h2(k) = max( 0., h1(k) + ( dx(k+1) - dx(k) ) ) + h2(k) = max( 0., h1(k) + ( dz(k) - dz(k+1) ) ) enddo else h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i+1,j,:) ) @@ -889,14 +893,14 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, ! Remap v velocity component if ( present(v) ) then - !$OMP parallel do default(shared) private(h1,h2,dx,u_column) + !$OMP parallel do default(shared) private(h1,h2,dz,u_column) do J = G%jscB,G%jecB ; do i = G%isc,G%iec ; if (G%mask2dCv(i,j)>0.) then ! Build the start and final grids h1(:) = 0.5 * ( h_old(i,j,:) + h_old(i,j+1,:) ) if (CS_ALE%remap_uv_using_old_alg) then - dx(:) = 0.5 * ( dxInterface(i,j,:) + dxInterface(i,j+1,:) ) + dz(:) = 0.5 * ( dzInterface(i,j,:) + dzInterface(i,j+1,:) ) do k = 1, nz - h2(k) = max( 0., h1(k) + ( dx(k+1) - dx(k) ) ) + h2(k) = max( 0., h1(k) + ( dz(k) - dz(k+1) ) ) enddo else h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i,j+1,:) ) From 03a247e4346ac3f21db516ed48d11202d15b9430 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 21 Jan 2022 09:26:29 -0500 Subject: [PATCH 49/73] Avoid divide by zero in horizontal_viscosity() with better_bound_kh - I division by zero was encountered when using the back-scatter settings (negative viscosity) in NeverWorld2. It appears hrat_min(I,J) can be zero. Reading the code, it makes sense that hrat_min can be zero. The division was previously made conditional in 14971b41024b96eda983 also when using backscatter, but then only one part of the denomitor was used in the conditional. - I'm not sure why the backscatter setup is repeatedly hitting these edge cases or specific line of code. - This fix uses the entire denominator in the conditional. --- src/parameterizations/lateral/MOM_hor_visc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 6a9b49683c..323c0ceb65 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1308,8 +1308,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (Kh(i,j) >= hrat_min(i,j) * CS%Kh_Max_xy(I,J)) then visc_bound_rem(i,j) = 0.0 Kh(i,j) = hrat_min(i,j) * CS%Kh_Max_xy(I,J) - elseif (CS%Kh_Max_xy(I,J)>0.) then visc_bound_rem(i,j) = 1.0 - Kh(i,j) / (hrat_min(i,j) * CS%Kh_Max_xy(I,J)) + elseif (hrat_min(I,J)*CS%Kh_Max_xy(I,J)>0.) then endif endif From e63c4055a4f12b862abac12f4ce4657495d0a7af Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 21 Jan 2022 09:27:59 -0500 Subject: [PATCH 50/73] Fix soft-conventional index capitalization in horizontal_viscosity() - A previous re-factor for optimization introduced some inconsistent capitalization. This made it hard to understand the code, especially with some arrays being re-used at different grid locations. --- .../lateral/MOM_hor_visc.F90 | 63 ++++++++++--------- 1 file changed, 32 insertions(+), 31 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 323c0ceb65..0249f79c2d 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1003,6 +1003,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, visc_bound_rem(i,j) = 0.0 Kh(i,j) = hrat_min(i,j) * CS%Kh_Max_xx(i,j) else + ! ### NOTE: The denominator could be zero here - AJA ### visc_bound_rem(i,j) = 1.0 - Kh(i,j) / (hrat_min(i,j) * CS%Kh_Max_xx(i,j)) endif enddo ; enddo @@ -1194,7 +1195,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%better_bound_Ah .or. CS%better_bound_Kh) then do J=js-1,Jeq ; do I=is-1,Ieq h_min = min(h_u(I,j), h_u(I,j+1), h_v(i,J), h_v(i+1,J)) - hrat_min(i,j) = min(1.0, h_min / (hq(I,J) + h_neglect)) + hrat_min(I,J) = min(1.0, h_min / (hq(I,J) + h_neglect)) enddo ; enddo if (CS%better_bound_Kh) then @@ -1217,11 +1218,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, (G%mask2dCv(i,J) + G%mask2dCv(i+1,J)) == 0.0) then ! Only one of hu and hv is nonzero, so just add them. hq(I,J) = hu + hv - hrat_min(i,j) = 1.0 + hrat_min(I,J) = 1.0 else ! Both hu and hv are nonzero, so take the harmonic mean. hq(I,J) = 2.0 * (hu * hv) / ((hu + hv) + h_neglect) - hrat_min(i,j) = min(1.0, min(hu, hv) / (hq(I,J) + h_neglect) ) + hrat_min(I,J) = min(1.0, min(hu, hv) / (hq(I,J) + h_neglect) ) endif endif endif @@ -1234,11 +1235,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, do J=js-1,Jeq ; do I=is-1,Ieq grad_vort = grad_vort_mag_q(I,J) + grad_div_mag_q(I,J) grad_vort_qg = 3. * grad_vort_mag_q_2d(I,J) - vert_vort_mag(i,j) = min(grad_vort, grad_vort_qg) + vert_vort_mag(I,J) = min(grad_vort, grad_vort_qg) enddo ; enddo else do J=js-1,Jeq ; do I=is-1,Ieq - vert_vort_mag(i,j) = grad_vort_mag_q(I,J) + grad_div_mag_q(I,J) + vert_vort_mag(I,J) = grad_vort_mag_q(I,J) + grad_div_mag_q(I,J) enddo ; enddo endif endif @@ -1254,11 +1255,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Smagorinsky_Kh) then if (CS%add_LES_viscosity) then do J=js-1,Jeq ; do I=is-1,Ieq - Kh(i,j) = Kh(i,j) + CS%Laplac2_const_xx(i,j) * Shear_mag(i,j) + Kh(I,J) = Kh(I,J) + CS%Laplac2_const_xx(i,j) * Shear_mag(i,j) enddo ; enddo else do J=js-1,Jeq ; do I=is-1,Ieq - Kh(i,j) = max(Kh(i,j), CS%Laplac2_const_xy(I,J) * Shear_mag(i,j) ) + Kh(I,J) = max(Kh(I,J), CS%Laplac2_const_xy(I,J) * Shear_mag(i,j) ) enddo ; enddo endif endif @@ -1266,11 +1267,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Leith_Kh) then if (CS%add_LES_viscosity) then do J=js-1,Jeq ; do I=is-1,Ieq - Kh(i,j) = Kh(i,j) + CS%Laplac3_const_xx(i,j) * vert_vort_mag(i,j) * inv_PI3 + Kh(I,J) = Kh(I,J) + CS%Laplac3_const_xx(i,j) * vert_vort_mag(I,J) * inv_PI3 ! Is this right? -AJA enddo ; enddo else do J=js-1,Jeq ; do I=is-1,Ieq - Kh(i,j) = max(Kh(i,j), CS%Laplac3_const_xy(I,J) * vert_vort_mag(i,j) * inv_PI3) + Kh(I,J) = max(Kh(I,J), CS%Laplac3_const_xy(I,J) * vert_vort_mag(I,J) * inv_PI3) enddo ; enddo endif endif @@ -1281,40 +1282,40 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! stack size has been reduced. do J=js-1,Jeq ; do I=is-1,Ieq if (rescale_Kh) & - Kh(i,j) = VarMix%Res_fn_q(i,j) * Kh(i,j) + Kh(I,J) = VarMix%Res_fn_q(I,J) * Kh(I,J) if (CS%res_scale_MEKE) & - meke_res_fn = VarMix%Res_fn_q(i,j) + meke_res_fn = VarMix%Res_fn_q(I,J) ! Older method of bounding for stability if (legacy_bound) & - Kh(i,j) = min(Kh(i,j), CS%Kh_Max_xy(i,j)) + Kh(I,J) = min(Kh(I,J), CS%Kh_Max_xy(I,J)) - Kh(i,j) = max(Kh(i,j), CS%Kh_bg_min) ! Place a floor on the viscosity, if desired. + Kh(I,J) = max(Kh(I,J), CS%Kh_bg_min) ! Place a floor on the viscosity, if desired. if (use_MEKE_Ku) then ! *Add* the MEKE contribution (might be negative) - Kh(i,j) = Kh(i,j) + 0.25*( (MEKE%Ku(i,j) + MEKE%Ku(i+1,j+1)) + & + Kh(I,J) = Kh(I,J) + 0.25*( (MEKE%Ku(i,j) + MEKE%Ku(i+1,j+1)) + & (MEKE%Ku(i+1,j) + MEKE%Ku(i,j+1)) ) * meke_res_fn endif ! Older method of bounding for stability if (CS%anisotropic) & ! *Add* the shear component of anisotropic viscosity - Kh(i,j) = Kh(i,j) + CS%Kh_aniso * CS%n1n2_q(I,J)**2 + Kh(I,J) = Kh(I,J) + CS%Kh_aniso * CS%n1n2_q(I,J)**2 ! Newer method of bounding for stability if (CS%better_bound_Kh) then - if (Kh(i,j) >= hrat_min(i,j) * CS%Kh_Max_xy(I,J)) then + if (Kh(i,j) >= hrat_min(I,J) * CS%Kh_Max_xy(I,J)) then visc_bound_rem(i,j) = 0.0 - Kh(i,j) = hrat_min(i,j) * CS%Kh_Max_xy(I,J) - visc_bound_rem(i,j) = 1.0 - Kh(i,j) / (hrat_min(i,j) * CS%Kh_Max_xy(I,J)) + Kh(i,j) = hrat_min(I,J) * CS%Kh_Max_xy(I,J) elseif (hrat_min(I,J)*CS%Kh_Max_xy(I,J)>0.) then + visc_bound_rem(I,J) = 1.0 - Kh(I,J) / (hrat_min(I,J) * CS%Kh_Max_xy(I,J)) endif endif if (CS%id_Kh_q>0 .or. CS%debug) & - Kh_q(I,J,k) = Kh(i,j) + Kh_q(I,J,k) = Kh(I,J) if (CS%id_vort_xy_q>0) & vort_xy_q(I,J,k) = vort_xy(I,J) @@ -1352,15 +1353,15 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Smagorinsky_Ah) then if (CS%bound_Coriolis) then do J=js-1,Jeq ; do I=is-1,Ieq - AhSm = Shear_mag(i,j) * (CS%Biharm_const_xy(I,J) & - + CS%Biharm_const2_xy(I,J) * Shear_mag(i,j) & + AhSm = Shear_mag(I,J) * (CS%Biharm_const_xy(I,J) & + + CS%Biharm_const2_xy(I,J) * Shear_mag(I,J) & ) Ah(i,j) = max(Ah(I,J), AhSm) enddo ; enddo else do J=js-1,Jeq ; do I=is-1,Ieq - AhSm = CS%Biharm_const_xy(I,J) * Shear_mag(i,j) - Ah(i,j) = max(Ah(I,J), AhSm) + AhSm = CS%Biharm_const_xy(I,J) * Shear_mag(I,J) + Ah(I,J) = max(Ah(I,J), AhSm) enddo ; enddo endif endif @@ -1368,13 +1369,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Leith_Ah) then do J=js-1,Jeq ; do I=is-1,Ieq AhLth = CS%Biharm6_const_xy(I,J) * abs(Del2vort_q(I,J)) * inv_PI6 - Ah(i,j) = max(Ah(I,J), AhLth) + Ah(I,J) = max(Ah(I,J), AhLth) enddo ; enddo endif if (CS%bound_Ah .and. .not.CS%better_bound_Ah) then do J=js-1,Jeq ; do I=is-1,Ieq - Ah(i,j) = min(Ah(i,j), CS%Ah_Max_xy(I,J)) + Ah(I,J) = min(Ah(I,J), CS%Ah_Max_xy(I,J)) enddo ; enddo endif endif ! Smagorinsky_Ah or Leith_Ah @@ -1382,7 +1383,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (use_MEKE_Au) then ! *Add* the MEKE contribution do J=js-1,Jeq ; do I=is-1,Ieq - Ah(i,j) = Ah(i,j) + 0.25 * ( & + Ah(I,J) = Ah(I,J) + 0.25 * ( & (MEKE%Au(i,j) + MEKE%Au(i+1,j+1)) + (MEKE%Au(i+1,j) + MEKE%Au(i,j+1)) & ) enddo ; enddo @@ -1391,31 +1392,31 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, if (CS%Re_Ah > 0.0) then do J=js-1,Jeq ; do I=is-1,Ieq KE = 0.125 * ((u(I,j,k) + u(I,j+1,k))**2 + (v(i,J,k) + v(i+1,J,k))**2) - Ah(i,j) = sqrt(KE) * CS%Re_Ah_const_xy(i,j) + Ah(I,J) = sqrt(KE) * CS%Re_Ah_const_xy(i,j) enddo ; enddo endif if (CS%better_bound_Ah) then if (CS%better_bound_Kh) then do J=js-1,Jeq ; do I=is-1,Ieq - Ah(i,j) = min(Ah(i,j), visc_bound_rem(i,j) * hrat_min(i,j) * CS%Ah_Max_xy(I,J)) + Ah(I,J) = min(Ah(i,j), visc_bound_rem(i,j) * hrat_min(I,J) * CS%Ah_Max_xy(I,J)) enddo ; enddo else do J=js-1,Jeq ; do I=is-1,Ieq - Ah(i,j) = min(Ah(i,j), hrat_min(i,j) * CS%Ah_Max_xy(I,J)) + Ah(I,J) = min(Ah(i,j), hrat_min(I,J) * CS%Ah_Max_xy(I,J)) enddo ; enddo endif endif if (CS%id_Ah_q>0 .or. CS%debug) then do J=js-1,Jeq ; do I=is-1,Ieq - Ah_q(I,J,k) = Ah(i,j) + Ah_q(I,J,k) = Ah(I,J) enddo ; enddo endif ! Again, need to initialize str_xy as if its biharmonic do J=js-1,Jeq ; do I=is-1,Ieq - d_str = Ah(i,j) * (dDel2vdx(I,J) + dDel2udy(I,J)) + d_str = Ah(I,J) * (dDel2vdx(I,J) + dDel2udy(I,J)) str_xy(I,J) = str_xy(I,J) + d_str From 65998cd3158cb68d65c41a01296266af712e472f Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 26 Jan 2022 09:27:59 -0900 Subject: [PATCH 51/73] Esmg docs (#57) * additions for stochastic physics and ePBL perts * cleanup of code and enhancement of ePBL perts * Update MOM_diabatic_driver.F90 remove conflict with dev/emc * Update MOM_diabatic_driver.F90 further resolve conflict * Update MOM_diabatic_driver.F90 put id_sppt_wts, etc back. * add stochy_restart writing to mom_cap * additions for stochy restarts * clean up debug statements * clean up code * fix non stochastic ePBL calculation * re-write of stochastic code to remove CPP directives * remove blank link in MOM_diagnostics * clean up MOM_domains * make stochastics optional * correct coupled_driver/ocean_model_MOM.F90 and other cleanup * clean up of code for MOM6 coding standards * remove stochastics container * revert MOM_domains.F90 * clean up of mom_ocean_model_nuopc.F90 * remove PE_here from mom_ocean_model_nuopc.F90 * remove debug statements * stochastic physics re-write * move stochastics to external directory * doxygen cleanup * add write_stoch_restart_ocn to MOM_stochastics * add logic to remove incrments from restart if outside IAU window * revert logic wrt increments * add comments * update to gfdl 20210806 (#74) * remove white space and fix comment * Update MOM_oda_incupd.F90 remove unused index bounds, and fix sum_h2 loop. Co-authored-by: pjpegion Co-authored-by: Marshall Ward * Fussing with zotero.bib. Getting a warning about a repeated bibliography entry for adcroft2004. Rob thinks this is a hash failure. * Still fussing with zotero.bib - it was complaining about the (unused) Kasahara reference. * Several little things, one is making sponge less verbose. - Pointing to OBC wiki file from the lateral parameterizations doc. - Using the MOM6 verbosity to control the time_interp verbosity. - Making the check for negative water depths more informative. * return a more accurate error message in MOM_stochasics * Working on boundary layer docs. * Done with EPBL docs? * Undoing some patches from others * Cleaning up too-new commits * Adding in that SAL commit again. * correction on type in directory name * Added some to vertical viscisity doc. * Cleaned up whitespace leftover from porous topomerge. - Spacing within expressions was uneven and made multiplation look like POW functions. Leftover from merging NOAA-GFDL/MOM6#3. - No answer changes. * Fix out-of-bounds k index in PPM flux - An errant use of the porous face area led to an out-of-bounds k-index reported in NOAA-GFDL/MOM6#19. - Closes #19 * Adding Channel drag figure * Take cite out of figure caption. * Copyright year 2022 --- docs/conf.py | 2 +- docs/images/channel_drag.png | Bin 0 -> 13890 bytes .../vertical/MOM_CVMix_conv.F90 | 2 +- .../vertical/MOM_set_viscosity.F90 | 2 +- .../vertical/_V_diffusivity.dox | 2 +- .../vertical/_V_viscosity.dox | 72 ++++++++++++++++-- 6 files changed, 69 insertions(+), 11 deletions(-) create mode 100644 docs/images/channel_drag.png diff --git a/docs/conf.py b/docs/conf.py index 5d84b3c37a..4407d88356 100644 --- a/docs/conf.py +++ b/docs/conf.py @@ -159,7 +159,7 @@ def latexPassthru(name, rawtext, text, lineno, inliner, options={}, content=[]): # General information about the project. project = u'MOM6' -copyright = u'2017-2021, MOM6 developers' +copyright = u'2017-2022, MOM6 developers' # The version info for the project you're documenting, acts as replacement for # |version| and |release|, also used in various other places throughout the diff --git a/docs/images/channel_drag.png b/docs/images/channel_drag.png new file mode 100644 index 0000000000000000000000000000000000000000..a665034ff08f7fd6dea72ef1d085704cafcc4abc GIT binary patch literal 13890 zcmb_@XHZkow{Hp|bO==`qM>&br4tYV5u~?B4WNQjmEHqNlO`abAiYWrNUxzNB2ol} z(1Rc-p$SM8xCebR?>}?rzWe2UU^uhSE^GZ(Icu%G60NU$la`8|3Iqbt-qKVv1cAWW zz+WE)IWS^=?P@UakJ4T9jtB5h{_GFDc{fQ57(DN(j`lQiyYJ~^`}iKn$Hzzffvb~; zy{-E_aks|~8S9GdAkan7Ew$^$zOUD2`~r=Cx1IhP=LM^(YIX@PLL$E@geOEr?d$&k8y2Bz1|gA24bMVPtQ3nuf_tm<@Ut`eEfR~& zUfwHM=?_-9wG|90*;I4`4GXM!i6jke3l|3sCGRQ82ecXHxJ_0k-EC?;wC^x#-kGc5 zdG#^*8WlI9kHw8ohCz_mq?3(5!H?TRM0>-2_SuD;5sx_w%DqnEhiMI6d#0b%(S<7? znIYD+c-Eody5*D9#RX6ten~f&E{Brv!n^!@iO#GKw-Z>pNNEWC@XCuS`R?lU#qG9- z$s1o2Z{O>`YhM$X`373=wY9H_DeSt*>pxBPwc_;=|Hh5dE$8= zWjR{9E5{oNV1M!kFZ}(aKzK#VaPIw#)>OqGk)#A#UXzKI(2)syYgazfv2+_{8NR_T zrEc$XLzp*r8IMWm+0m^HkA0x{pidkOGY9pem-9Cf4~A$%waN`8I)x9weMiuwqjh_h ztfTK}iWitrLk;0`maee12<+ZeU{UWF|K5y>d&jGB-fW|c`OACD>Z-Tqc?=dJB3f7+ zWXC4#pFEiICp?3x1hMUndv5zV8KlKWb=_1gK6mcLG!K!S-~Mcm_Z*f&>KlAXvH zd&#@zz=w)Q>-AUs0_`V%>GavpCifwe?on~~r9d!(lCht_NkV9HTPtHRd<0#+9=72D zH~ZJDBP!a&=SKUQdb~Kv^W>{o9aawVSj`q?8tN=n4A-k0i>KIzE1WiZOY`|i#!FP( z;G+;p2!WD-;E3FyeUVsTe%UoAFm>9L&utEzr88?o8~AL{ElLy4jQXVyiG_LJnvDl* z*j|6jH1_O4r|N=zxf96eZeNK&UCh0_oH%b_`u`Uz-LjKf`Wlv zW#w$9{EQ5$@zosRlBj<;}0lMJQ zDcw|x>ibB^OMWc^IEXLpKF6lEsG}*|NDVM!!~I3m zOWwLm#M%mWU!JC8R$my0IzN(;nksvh{gyC>9~@~faw`5VY^i>6P5Fs%PL$?3!NB@C z6{4i!B`Ji(^DUk7qg69Jj6lThP%A`7^`v(dA8A07LwS-Kj_f+OkeeLDE6%AMsnu+V zpJ81BQhSyIyrPc$wj$tGSS#ocXkSWRj|W*}#f&OqmVI7tYxIfUd!i}h z<;dfeSmR}p*KgfgVF~^%vX|9$Q;qj-7b8lYkb@P*(76lZQq=ModVkWZAPxG0kM0a} z28eQc8Ha^J6@t}^uX&ug*-K2u`^*gub2z~SC>HIGsO{0k@V*%BlpABeH}e~8y>H>UZv+8Pz&kSP1;aN?WkmGjK1T1W6$ z^D8Be`-4xdyeVx+MN+^wCUJNxV#qc2+`ObyYMfSCsg}MuJG#?f=P#cwLkEApOHg{x zT+7M3`|3;!YN^7+RR$ehWPpXwT=z@9pTPlagZPyRyjBY=-b5e}bMGz%UL~pkI`fSI z_3!{t-`k$uH`$Vz5R?@^A`;BckSY8-Q7BMNt;grTt^bc5klR{RQJGIbny_@BA80ssMyE_2yuRuhad%%8bBbY^3dMLI}?{^iFi zGk`w)AB@yXvc=;5ZYOp|ZjaArT5hqbGu(lPzYJ*qW#B&|oEBM{I#U3qr?F>P|4#u= z%a3^Px8J>(6#>;_{+*g|Cf}$35h00B&NCIx0fVY}T>mgm`in8!OzzlU%`xo%zam#x z3N#NBkBEw@Wt-Xjyd@8i&oZ-V&;a1#_zySshhk@O*nh0~H~v{^+5WG?U*JXV?y~ zH?GxVv|m_hT|^`@2!qyLX0&;Uk;-aNdVt6@s!i+d_m41Ng&P;*@l?D>Z4c`~CwW?)u%w^lGc>W5x*jk>K6KzC;N5H&VVT9cQUF<1NU=5`FDCUA~C zH8-{jN*52^Xoc?0PQ4pdS5s>qGudyAs0e&6zc)Jkd|Nd-O0(9B1qGVxaXJ2TG-v+H zTusftLScTJ979^=W!zkITkid;d+p4T)HXAr0K8Z^;igrC#bueop@8v}w9LO{-WLPL zH$u3jT|VB)1<;;s<^afq(8|)4Tfk*zUX)z{j_LW$8;F9q!VS$7Dk=wW{hjB}h{8Cv zfBhzld&FZI5+wfd1sA*fMSvl|xz{zOP3iIydzB-uIn`K~lxsR(cS0oMRvzqw{!pNw zEZ|ecq<7?F%fII@B}8dbxajRWledpI`y8!p4u#yWPytjgXo?91Y5;FQhDRWC`x;|^ z<=)UXKS~x@=Cv^&Ip4HgW0+I^h|~S*3cz4&y-XmUKeL^T(043SNijzuMJvyMpe&qy zN{?s3h7XoibtUn&NhC%^sad;qFH7LLK~DE9gXNs3#z=pG{4E`bPn~%H=-E4}#@}P2 ztp&i;JJMYaLhdpELS}^-;8=6*&KTeYb^+|>Ur3g}aKGDUo%-hM^&!d#L|>St@t_aX z4a^EkvmzfDkn_zDXJ%GG=KiGwcqfK0#17Q?9l7j(m+;t>w!)<*u=)TtcNu=})%Wp0 z3U^Ij&Ip=EC2tL^se?Ht|QgrGyTi zeTPiNMV9G*=_J3Y05&w_P>zequ2fy z(46Z`z>iC(5!NDS-;4eP4`c)A6eP;fzQyAB@Z)id@W0{B2juPKgkh4;Y^cp2w3ytnpC?fYJN}!P$d#38y1FdM&P$2tw1v4_fWq@H->4Wp78s6Nz#sl@;`XmN z3k7mb78e5AV#E{=O&BTn`}ByfJunGMkGEar0bg-Y$gQ8$YD4y-P|5oGk$lCuAKCMD z!cv^1?7(23tPEGsa52XaNz*3hs$U1$A6jl)qFeF2ERT7lwepU>>nxD^AcgLsgO*M6 z3en-{Fq1>qcdHej`fp{*?3%W(52^HqCgQugz6Xgli2kffxusN(d7Jhmj#t+V?yRja z266thIW4AgW3u{wPJMEXXHov%qiepiRfs?I**XNi2A7`BZu;(Iy{_5^6Cnb$vJ8~@ zjOAff7fn95urwa6HPV|-w4^izSWwXPpvJ$~RuE_0He5;gid8s&$Y6g(!OXKDr>&Fv zMSEKGcbeg+UoD=O?vRqEG|ER{gxfWSg)W%Js)^4|O|4aRLI=|&?39*2eD*=p;Mdfg zlkz)+7ANYL!0NcI8_qzft6N#Q6MTS23)S!I!01 zh&bajzpNa2x}UJx9z)KlsmOwTavmJmAG$iAqf%Q4x7Li(mgH&6k!Di!y5VRsiLh|IAGtfgr%EM&5dP(in=x-k$0u zsB=gu)o1MrWT~t2eb_vp*%#mB0R`_$$&y50%3fBes`Nl5DX8Nm%NsE8p*7s1G_Q+D zk2%6Ac}jk0_tNI$$!f2HL5CR571}t|qnqcFo5TfyB0l_Js*v0AJP@v`26tL*`Xfte|>C@6U`BMlF;ezXvY%)&=fonVvR@^y_}|%wG!-a zmSaEc(;<^KR5?%>>VzV4?$$q#hq@icM1kdu3QYzSt8hy)#R#2J=SxQY{E6;_0Jlhq z;Lm^s`Rw;9U&$V_=$Jk7$cG$MsPT@ga-qTr2cWV>I{6Q|Z{9e}O9j+hL>Joh->4q~ zVT3p52qkYT(EUZxJ2)Xx&vVMN^V1$&>m40OR>d6BzBUfMD#6-_zB>I#dVHs^NWF#Y z&pZ2{UM-l~v7fICihy{8X5jej)2nR<*DR#f)#>2etL_Ki=@Jy}F4ZVm6<)hGJ3b@y ze9m0$vDnT$R2nIKZJ+pdsM#hl(>Ko|+RHoI{MLEOPjFZGY_Doj*6n3yEiF!dof@3q zicn;8^BQ-`kC}%~Z5vYjQOaRai%nWTSCrHak&&0Krl@hoc5-1;d!fo9LRaA#+9rtHJgfYE*d zv)#?WgXJylN=OK^YyD=f3*ceh#(-*L~Jts@{JP; zMT$>6iMW0j2`j31R(G}Xyqbegoo2^@8(Xt$LI3&P!q@GR*a5)#|BXqF1y!=lsR;S zSlSR*Wfjbi;d-%*RMrr4X)706+S$kP)ZgfZkaB4~}?r`p%HPYsKOQzY~;@96y z?Vu2GpUPO+AS@XE#V*FBQebp=x#mh_Y3XLT&f(aXMX|kom6K9rl9L}B3P#x4HEXra2@W9mm_ zPM@9e8ijS)4n`*5-3PAGNwhw1$sM}x93H;D;fIktr9mdy`;D(Ht-xEKSRg`vYQGYx z9@X^_ss5;^Ked;#S;JS5&gnptF{);EImB~L}qwg3WM zBX@^c0YLhcG4gcI{(hyyaYZgXFxx*iQWh)NILfB2a6q|P}4 z)17Z5aQ}ULc&YGIyaFA0IGnKs?o$Fmd_a0?Ah+pTsNF3LO6IauXw=wXGsQ!xh~x@qlI&uAH`{_ZNv{W2=TRraY_}f z`DI+X;eRl8xnL6!9WMBE$ltkc=?KVszQx#1*3L!@p@GVnaJ|a1w6i-_A+OU^r=-00 zo$SoEbjyQFOV&Vo-lNLg1t-ejA)F2uvV+Khv_P-hfnm%)J;v)zik;Pi^}K>zA7N4F zsg%?z5z41`R_1^*45O_9B{weoW&*iz({EFPkIkNMk(OxaKu$L7HO(ruGwd*#O2p~A zZ={M|2Ko1c8jNZdkeBna<}stnurZ-6k2rlvVtb8KSB2i0%f#SF(~V_TE#q<3rh}XF zZ*Z^VSv2Cd@>jnJJGaFG6#(8YU>&G~eCeC4KtTKqwJ`{k8+1qY9+6sFqxqW!1c*f5y!;is%NJdpL76IZiB03loW}1u9~|Cc$_%Xb3nb7pyB!i8|mVFy4Ch zcbk2%TPJ_^G zN^h;fD*`yA2^5Vw8DSy@uYn?r-F0sFZ7X8yFH)06{0frYfSkNG41apSr{#HW=hxRN5?j>QUkHi=rJiV5xL$8C`Jd*2#Ew5O@y3fUM|#4~P+&%7 zDscNY3?$n8fdp?QW3-syXMpMNd%8+_pA=UPe69*+xe#>qIYb?(WuMKrI)cykOMq%? z@#h@~S`rh>-L+iXrOcl2)nP{31`A!d5rac=w!Qedw($*`z%G^ zpCa_3;QNrx^ksAiMnuG{D_WpyY2a0eA@K5Y?q*+{KSmt)(WCsFBhfA735+`DjnK=a za4XeUJdALv?CCq<6q@weIdvG6BTu1~m6 zWuvZyXEe{8>1uL-k8Rn-#zQa%xDl`(V(7(>%+~+ZW`Ds6&#id$9Zzm17x{!MRcoRsSs14m{QRn-(&KIJh|MWWHGz&i1W##)tc!CilqMg>& z>i4Ui?)g7u?QG=UPj%>^;0T-fcABh0#7)75Ph8;EG&52M*F3>M;~9kVR2+_xdmvdS+BlyQzq3IfEX~ zG`QChTYvftzkzvN~5-&U{OwOLqjOU_4F7iy^YqeRP!rOaPYyYW7gK9~=i!WW1O*$1y( z_T#K$Og|}&`bxn z?tXL@=j~2C5qcG+37Fr(hWN#x7oB889ZvY5GWU9$%-= z<*6_D@xDy@ZLC_h64evhB_Ll}90Xc}wd&dPe9ES$SLVFk=il|HIXFIQQ7K%n){@?G zX+jUw0_GkW#*pygZLorW9w%@4CVpJ;h!P{ZiK3+)gZTf*#b}Lj0oOQZz9s#Hd($Q> zr~$TP?L;m33CxR3EZ&T+Bw^kBcbV|(_zp+sT9E%{=b22afj9LV(6j*HO&0#Avjt?ftn^+M>HiMg?G16AVq}Th*jQg}&h-C2C#(Vno;o z27X(Uw2BP{rJ|gGMV7*_WE)B;;*&3=z6ge7Zs~XkJ8cI z1`zFogs)JG0QXNpaptRA0$=+cJFn!>ROfC+SKSQ#**8_QSba%_R!4_L)RMxY9?#Zs z&iJ7A%k_0yhz2A-6wx=8h&Efr7+x}phpFuw8+$5g7FN>LyNHnf+zKu24*Nj+;h|w? z-DSU4@g|$h))|PiE^2*!oWDT~y&s<5B`|wJ!wFZ6H&Mf+4DhFC^vf=D5^5>iw^Hy_ zf^DXu18eN`vE8g0Gf+bGI=PlXqRAEui@r5oO3It#_MqHyn!}w?FtoWHMji9)S^dU5 zs`qPy#EaD3U7w-yH+?5I0bj>d-!3=DS~REz1sxrI?TgR}YUA2iL3??v9M`+Ny;v)G zyUoGNi&7tAeE(O2Czf3_XWG4#pT#ai6E^;S(f(^+_ODsjLAzIz`uiW8@K=cmc-&(3 zl^nWWq4^Q*wHsR%ZZK1opY@mVm-^OJL>)Em2HrP7&~Vc!tda5D>?$$9EyR0=>^PoN zlx2}@q6*DnX1Rm)FWfk)XqrGdxT<^|n_Np3(>H=<$V?rJS%?l#_e#5j#c>!V0B@?r zEEvChH5oZl@vyM_nY%da?HR(w`jE?Tp90T8VA1F9O(lYl_{Tsy-&e}kl#lAh$xToX zsvxp7FExeTBkBUiaJG`cim@E94+a*SiKLNjY0wpXU+c2H&(3%XyO2duS(ci~3G0;bi+{r#M)L z>?`(3J-PiU$|z|nxF8!l=Vd0l$S}o!8{4)=cf!#|CXk2=Ih{S>CN$SAxPSC?KKAz! z$!iaml~f$<7Y^(p8I{`|iMa=Ep)ZYvye2MXps17BTTSZ&FazR*mJfPdO$g%n?k&eIaM6Sj2fA}Pb4Gi;<=nM@w7Qp zZVjx%Rz7#;n(k@~js3opGELXRA${*2>s8=#{6W&pURDkpWquOlltx1R@q9N6YUB;M zGjhe8*xzUW#uXQ^Q3o=wAv^p{o#UIR4>YG#_pLFsX7_eJ0kU@4L&ugG2kts)J|Kn| zNn|D35pNKCYn9*&n?Ld?mj<599n&2~dQfRntVIu0q=$MH7oNBm7P@~ia9^#i=W@q( zX&`~*%j$qq`q7%Hq0|?#s0#r!z(*>QyWTa|IcltQtPovx-~Tbk)S>2FyF0;_^=dCy zvFp`nuJ8oU-YRTDbtr|4101!-$>|Xb`#ijMKJL}~zN2tj4X8);_Whf7{Ua}}yhDKq z;XMs?X30P{;wKnbIW9%;i=MNWS~QyV?QV|E^6lamdp{(OCVYa&<6X|PvUM-^No(em zQqiGg@yKUSW4dnoe+w#q90XEuNUU*w<;A1)i)^)JW4GhRiDwHJ*=w>--KmwAZ$x%c z3IM_DSo7xt$;4Oy5+hReci&(-QRnRsD_^Crkmy6O-SqT%&P~z?Sr(`H)oFjv;!IIz zAYV(>wRK~)VT}e_+ME+y2VFd zq#aZ56E=Q0s26Ym)LHC7%dqfjKHJ+jps$0Q>wuD^L`lu>9$iAuf4?(5ho<=SzAbP&=lWQe+yV_OK8hYv zMagSe4{?A>fMpWR5#ZnhZBkgva@IPX@}T!x2pOv^wR_d%WK}jTJGznK{$Q;MT&;%< zpeuX|h(gx811|jNguATw=O=hO9Gp6fdg({U8MiQO_`QBYA0ahVYZ@|OQ=or4NKJ8#>70$cvBdb!1bxlPL&dG={*-Q&mG?Z^=*a6sXw<` zy1(f|6Vl+|!D<|ALd!YJfQ5yHa!`rwWLE}=v>F!~VF{X1KzJAIPpd$`LruI3N>6td zAO4uKnYrOPwk6b^x+4cCaN}YsOn{!o4hn&+lCsigi-_=qeHR{S$eJB7QpJW7-oB?~ zalWOXCn#%bYXT-qPtC=FRC@Tr>rJLlmKD!UwXOKBn_)zZnPw0zN4yd{mQTA?L^a`k z>Z%-AFeeAUv}oy>NPA(JuSk6>9hkX;9HaFSkfg@(`F)}U(Qr~YWYgN5Tv=^)0;w}6 zTI%m>4v#@SaITG{&B|wzuAGWTqOs=?`k&Q!&A#|tvL$+V>p)PhO3lvaR~xuRt)0v6 z#%SIZ4CK9S-CddOA+nBr;zc4p6ImUZ)=u?}w2RTa0QC3~zCceyD-_#GfBy*Bm?#~M zZh@h21X*GNc20okFgy$#JYkPGZdoz4zOcVu(c^MR8wYnyX@yNId z+}w|aThvmRR(#xfi)6F|1P=GHO;hu29{}{WWuu;@tg5jqm4rxa&Dl&0tmc#@Z)CJ6 zzj|#yr+rqVXRTe~&rUJ>d4VK2Gb%|h9S2k217|ty{g|wC|MiYlwP9u{6DN$kln<=k zx#Ue5zKzvcyKua3Z?WgnMdthGQAa;Na^`I3@0c{w1-RntU%xs|x$b|$-byA`h5T;t zM2-jnO50+Bw4GM5_zZbjU;4*V=WqvRzlYPAvoRxeNrPf&ZuxN13^RJ*W#Wg<@T z_$sG6R>#z;x@){ETGN7xJ32|PnpK}=({<852+L}2o{p{|d!OLb_>HRM&9AoS$h^%& zM}P8`$)9G93UYNIi@vt_L;uKkF>6<7W7uw3SuuQPjurz>G2y8<+(iKns#ObjdPE}N zI?Yu8gOQmlms3Te0Mx%6bI4M1q-V~u$ng5Lq<<}26MnPKnOnqfLoLK80}vA9&^OJJ z2GYQY6{b{pJl&mPTW_W|H-`w8YVH7DLwCBeu`P6tXf5?&2dn|E!wZO7kUM1F%U?(> zpwD4SoHg9n%-d_y~c`bObfdHf88tO;U9F*;P)$D|Cx zQVW%&$?UC62$TP7??hAsXF;s z$*8z%dx!@)1r*op(s6a)yrGpj$6)(8Dqs< z#<968NNaXFnPC_<5x7t`Yiy~og~ED5$ZacoO*MI-8>`Qm&s}_su^B-~-Q7ovK23#^ z4oEh(W1<{fK0`|B0=y$YdaJpNA{XxzpLzaKdX? z6F5*wlMix_DE)AV0M^pN10qda^7C~aQn)<-L6JN1bACDM_n#8?Y zD?D=!Bef8g-aYc6ge8T-Dkz4vb5zf1@VOe`Vt9SB;7cGlsH2Pgk}nG;f0^8#`c-hx z`#7=bpa!uyso++tdtTqQY^cS)MXGI$b*3ikZB(%)uD$^c_Cz>ujCOjY>(E_S- z?Pqfp0Ge|R=tM!{WV@tAzl=~?g4!4oBrG!j!icyt>Vj7d_5aMbcs9$EcN0eBUCs06 zx8t)8BuXdt)b?L_H z^l+cR6m0X$H33_oU!#wM1r5riM!vuxb=?Wm+@-3I(>3 zi0d)Gu^q~z85Arv0r_H=Y)%dS0hE;$2Ah|Fc&w&|lg*4b4w$$R2i7e(x^5g-7bO}s zZQ!xJJXO-PwKbh;N(PXQkYaxss^gd$ufQ(;mK?+5eMylzFZj6J5U4}ElG1#*VDzTKN;Rr6S$EWF5=`FlOu69}*w75MOv2y%H%DrWh#(wG^aHwPLwA}2ZX zJaZWM9ZDk{Y?w_Zm99T zVUXpd&P&E}wfLUg7mYRKS*D_%$90QFEe(b%?R~O+#8(AqKkpMVNdzfX0da2b-F5?n zRIROAFvzsl5%LhaJ{DGrWBqKry2X$=5f+!j5xe(##5$m}{La{w^s9Xl-r6SsTv7DX z>rE4VE_Y>u@AHfavk&_hlzh+_HZhq1t{>|!WG-?8Kcd(#2gyD+E-NWZX#}%}>JWZ3 zePQ>4lA}RfKCg8=XF@`(R26|tT#Xl#k4tGRwhc9&h|8Xc@*1V>o>Dh6C6Bz2{_y+* zR|DTOMAfK5p*V(8;6|z0V{JnWO)BAZ6M49(DZ6w|_K&-QP3=Z|J=GI3Jpiyvrq9F< zq~IBg@h7Sz z)bE(x34yw`y0n4oNvlAWRa1@GF8@anhBU+#oe5p3)Is~qfUbz0H%3#~_fE1{`OI0hu zwQcuRfxa`9xO|0CR<=n;%k{Wn!D|JVYRFXoxLc)JO1P?q(VNg|x_{v+#m9arx0IB% z1oevkAtqF&SfV(R5muHomEU*VjwbyWUi7|L&u?WGgt&7Kp6C_MkPnjq@4V-Z{WRM& z=GxzA=cJ|Fp{^_utizQZrNdymQgV5lh{VPRAnRMMl_&UF{0TldtD@xwQTXR9K2qK} z*f6MulNODZLt|KMD@yHhUb;+a5$Y?RudKMT^4y%(hdSk6U&4?^d&3Zhou+8V+&iY^ zBBr(N1wa{COplfSg+a(&WXck5+K_U{Pbu12k3 z`4HSC96tg|cCH+ox{vz{K-4)10^89%x?%dFp_S)P z3!4!$hp3|7v!>-mHENuE({V+lvPD>3`N!&Q6==2OcGhv##jhSF8dIjGHdkzx6i4OW z7)~Y-v`_suhWxVUB8|~>yk0`FD9_3ZXARxRiRB36km*h)?+yv+58u4@qUn^fqxgUe z3?m+}K(>Yx(5k5h*u($QR{h`GqW@n_*fXc_CC-g*?djNJ;P+pkTk5)Mm8zJq{{q`M BAUFU3 literal 0 HcmV?d00001 diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index fd2fe78907..7371ba7009 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -101,7 +101,7 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, 'KD_CONV', CS%kd_conv_const, & "Diffusivity used in convective regime. Corresponding viscosity "//& - "(KV_CONV) will be set to KD_CONV * PRANDTL_TURB.", & + "(KV_CONV) will be set to KD_CONV * PRANDTL_CONV.", & units='m2/s', default=1.00) call get_param(param_file, mdl, 'BV_SQR_CONV', CS%bv_sqr_conv, & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 350f73d164..fb969953c4 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -911,7 +911,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) else ; L(K) = L(K)*pbv%por_layer_widthV(i,J,K); endif ! Determine the drag contributing to the bottom boundary layer - ! and the Raleigh drag that acts on each layer. + ! and the Rayleigh drag that acts on each layer. if (L(K) > L(K+1)) then if (vol_below < bbl_thick) then BBL_frac = (1.0-vol_below/bbl_thick)**2 diff --git a/src/parameterizations/vertical/_V_diffusivity.dox b/src/parameterizations/vertical/_V_diffusivity.dox index 8c4c8ce7aa..f3b7ed5962 100644 --- a/src/parameterizations/vertical/_V_diffusivity.dox +++ b/src/parameterizations/vertical/_V_diffusivity.dox @@ -278,7 +278,7 @@ The original version concentrates buoyancy work in regions of strong stratificat The shape of the \cite danabasoglu2012 background mixing has a uniform background value, with a dip at the equator and a bump at \f$\pm 30^{\circ}\f$ degrees latitude. The form is shown in this figure -\image html background_varying.png "Form of the vertically uniform background mixing in \cite danabasoglu2012. The values are symmetric about the equator." +\image html background_varying.png "Form of the vertically uniform background mixing in Danabasoglu [2012]. The values are symmetric about the equator." \imagelatex{background_varying.png,Form of the vertically uniform background mixing in \cite danabasoglu2012. The values are symmetric about the equator.,\includegraphics[width=\textwidth\,height=\textheight/2\,keepaspectratio=true]} Some parameters of this curve are set in the input file, some are hard-coded in calculate_bkgnd_mixing. diff --git a/src/parameterizations/vertical/_V_viscosity.dox b/src/parameterizations/vertical/_V_viscosity.dox index cc59e83457..e40123386f 100644 --- a/src/parameterizations/vertical/_V_viscosity.dox +++ b/src/parameterizations/vertical/_V_viscosity.dox @@ -1,4 +1,19 @@ -/*! \page Vertical_Viscosity Viscous Bottom Boundary Layer +/*! \page Vertical_Viscosity Vertical Viscosity + +The vertical viscosity is composed of several components. + +-# The vertical diffusivity computations for the background and shear +mixing all save contributions to the viscosity with an assumed turbulent +Prandtl number of 1.0, though this can be changed with the PRANDTL_BKGND and +PRANDTL_TURB parameters, respectively. +-# If the ePBL scheme is used, it contributes to the vertical viscosity +with a Prandtl number of PRANDTL_EPBL. +-# If the CVMix scheme is used, it contributes to the vertical viscosity +with a Prandtl number of PRANDTL_CONV. +-# If the tidal mixing scheme is used, it contributes to the vertical +viscosity with a Prandtl number of PRANDTL_TIDAL. + +\section set_viscous_BBL Viscous Bottom Boundary Layer A drag law is used, either linearized about an assumed bottom velocity or using the actual near-bottom velocities combined with an assumed unresolved velocity. The bottom @@ -6,8 +21,6 @@ boundary layer thickness is limited by a combination of stratification and rotat in the paper of \cite killworth1999. It is not necessary to calculate the thickness and viscosity every time step; instead previous values may be used. -\section set_viscous_BBL Viscous Bottom Boundary Layer - If set_visc_CS\%bottomdraglaw is True then a bottom boundary layer viscosity and thickness are calculated so that the bottom stress is \f[ @@ -31,7 +44,7 @@ thin upwind cells helps increase the effect of viscosity and inhibits flow out o thin cells. After diagnosing \f$|U_{bbl}|\f$ over a fixed depth an active viscous boundary layer -thickness is found using the ideas of Killworth and Edwards, 1999 (hereafter KW99). +thickness is found using the ideas of \cite killworth1999 (hereafter KW99). KW99 solve the equation \f[ \left( \frac{h_{bbl}}{h_f} \right)^2 + \frac{h_{bbl}}{h_N} = 1 @@ -56,9 +69,54 @@ If a Richardson number dependent mixing scheme is being used, as indicated by set_visc_CS\%rino_mix, then the boundary layer thickness is bounded to be no larger than a half of set_visc_CS\%hbbl . -\todo Channel drag needs to be explained - A BBL viscosity is calculated so that the no-slip boundary condition in the vertical -viscosity solver implies the stress \f$\mathbf{\tau}_b\f$. +viscosity solver implies the stress \f$\mathbf{\tau}_b\f$: + +\f[ + K_{bbl} = \frac{1}{2} h_{bbl} \sqrt{C_{drag}} \, u^\ast +\f] + +\section section_Channel_drag Channel Drag + +The channel drag is an extra Rayleigh drag applied to those layers +within the bottom boundary layer. It is called channel drag because it +accounts for curvature of the bottom, applying the drag proportionally +to how much of each cell is within the bottom boundary layer. +The bottom shape is approximated as locally parabolic. The +bottom drag is applied to each layer with a factor \f$R_k\f$, the sum +of which is 1 over all the layers. + +\image html channel_drag.png "Example of layers intersecting a sloping bottom, with the blue showing the fraction of the cell over which bottom drag is applied." +\imagelatex{channel_drag.png,Example of layers intersecting a sloping bottom\, with the blue showing the fraction of the cell over which bottom drag is applied.,\includegraphics[width=\textwidth\,height=\textheight/2\,keepaspectratio=true]} + +The velocity that is actually subject to the bottom drag may be +substantially lower than the mean layer velocity, especially if only +a small fraction of the layer's width is subject to the bottom drag. + +The code begins by finding the arithmetic mean of the water depths to +find the depth at the velocity points. It then uses these to construct +a parabolic bottom shape, valid for \f$I - \frac{1}{2}\f$ to \f$I + +\frac{1}{2}\f$. The parabola is: + +\f[ + D(x) = a x^2 + b x + D - \frac{a}{12} +\f] + +For sufficiently small curvature \f$a\f$, one can drop the quadratic +term and assume a linear function instead. We want a form that matches +the traditional bottom drag when the bottom is flat. + +We defined the open fraction of each cell as \f$l(k) \equiv L(k)/L_{Tot}\f$, +where terms of order \f$l^2\f$ will be dropped. + +Hallberg (personal communication) shows how they came up with the form used in the code, in which the +\f$R_k\f$ above are set to: + +\f[ + R_k = \gamma_k l_{k-1/2} \left[ \frac{12 c_{Smag} h_k}{12 c_{Smag} k_k + c_d \gamma_k (1 - \gamma_k) + (1 - \frac{3}{2} \gamma_k) l^2_{k-1/2} L_{Tot}} \right] +\f] +with the definition \f$\gamma_k \equiv (l_{k-1/2} - l_{k+1/2})/l_{k-1/2}\f$. This ensures that \f$\sum^N_{k=1} +\gamma_k l_{k-1/2} = 1\f$ since \f$l_{1/2} = 1\f$ and \f$l_{N+1/2} = 0\f$. */ From 3f58f8a3abe355fa818d4f5d888f3c13c95a6070 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Thu, 3 Feb 2022 00:24:17 -0500 Subject: [PATCH 52/73] read_variable_2d modified to accept 3 or 4 dims The read_variable_2d function was previously configured to only run if the start and nread arrays matched the size of the field they were accessing. This was incompatible with the history of the function, which had previously required a fourth time axis (of one record), then was later modified to not require this axis. As a result, there are now files in use both with and without a time axis. This patch relaxes this check to ensure that the read is quasi-2d, i.e. the first two axes can read a segment of a 2d field, but will now reshape the start and nread arrays to match the field being read. Some additional checks are also added to ensure that it only reads one 2d slice. --- src/framework/MOM_io.F90 | 107 ++++++++++++++++++++++++++++++++------- 1 file changed, 89 insertions(+), 18 deletions(-) diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 2ea19df183..8928d2e56b 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -892,9 +892,17 @@ end subroutine read_variable_1d_int !> Read a 2d array from a netCDF input file and save to a variable. !! -!! Start and nread ranks may exceed var, but must match the rank of the -!! variable in the netCDF file. This allows for reading slices of larger -!! arrays. +!! Start and nread lenths may exceed var rank. This allows for reading slices +!! of larger arrays. +!! +!! Previous versions of the model required a time axis on IO fields. This +!! constraint was dropped in later versions. As a result, versions both with +!! and without a time axis now exist. In order to support all such versions, +!! we use a reshaped version of start and nread in order to read the variable +!! as it exists in the file. +!! +!! Certain constraints are still applied to start and nread in order to ensure +!! that varname is a valid 2d array, or contains valid 2d slices. !! !! I/O occurs only on the root PE, and data is broadcast to other ranks. !! Due to potentially large memory communication and storage, this subroutine @@ -908,11 +916,40 @@ subroutine read_variable_2d(filename, varname, var, start, nread, ncid_in) integer, optional, intent(in) :: ncid_in !< netCDF ID of an opened file. !! If absent, the file is opened and closed within this routine. - integer :: ncid, varid, ndims, rc - character(len=*), parameter :: hdr = "read_variable_2d" + integer :: ncid, varid + integer :: field_ndims, dim_len + integer, allocatable :: field_dimids(:), field_shape(:) + integer, allocatable :: field_start(:), field_nread(:) + integer :: i, rc + character(len=*), parameter :: hdr = "read_variable_2d: " character(len=128) :: msg - logical :: size_mismatch + ! Validate shape of start and nread + if (present(start)) then + if (size(start) < 2) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // " start must have at least two dimensions.") + endif + + if (present(nread)) then + if (size(nread) < 2) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // " nread must have at least two dimensions.") + + if (any(nread(3:) > 1)) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // " nread may only read a single level in higher dimensions.") + endif + + ! Since start and nread may be reshaped, we cannot rely on netCDF to ensure + ! that their lengths are equivalent, and must do it here. + if (present(start) .and. present(nread)) then + if (size(start) /= size(nread)) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // " start and nread must have the same length.") + endif + + ! Open and read `varname` from `filename` if (is_root_pe()) then if (present(ncid_in)) then ncid = ncid_in @@ -923,23 +960,57 @@ subroutine read_variable_2d(filename, varname, var, start, nread, ncid_in) call get_varid(varname, ncid, filename, varid, match_case=.false.) if (varid < 0) call MOM_error(FATAL, "Unable to get netCDF varid for "//trim(varname)//& " in "//trim(filename)) - ! Verify that start(:) and nread(:) ranks match variable's dimension count - rc = nf90_inquire_variable(ncid, varid, ndims=ndims) + + ! Query for the dimensionality of the input field + rc = nf90_inquire_variable(ncid, varid, ndims=field_ndims) if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //& - " Difficulties reading "//trim(varname)//" from "//trim(filename)) + ": Difficulties reading "//trim(varname)//" from "//trim(filename)) + + ! Confirm that field is at least 2d + if (field_ndims < 2) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) // " " // & + trim(varname) // " from " // trim(filename) // " is not a 2D field.") + + ! If start and nread are present, then reshape them to match field dims + if (present(start) .or. present(nread)) then + allocate(field_shape(field_ndims)) + allocate(field_dimids(field_ndims)) + + rc = nf90_inquire_variable(ncid, varid, dimids=field_dimids) + if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //& + ": Difficulties reading "//trim(varname)//" from "//trim(filename)) + + do i = 1, field_ndims + rc = nf90_inquire_dimension(ncid, field_dimids(i), len=dim_len) + if (rc /= NF90_NOERR) & + call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) & + // ": Difficulties reading dimensions from " // trim(filename)) + field_shape(i) = dim_len + enddo - size_mismatch = .false. - if (present(start)) size_mismatch = size_mismatch .or. size(start) /= ndims - if (present(nread)) size_mismatch = size_mismatch .or. size(nread) /= ndims + ! Reshape start(:) and nreads(:) in case ranks differ + allocate(field_start(field_ndims)) + field_start(:) = 1 + if (present(start)) then + dim_len = min(size(start), size(field_start)) + field_start(:dim_len) = start(:dim_len) + endif + + allocate(field_nread(field_ndims)) + field_nread(:2) = field_shape(:2) + field_nread(3:) = 1 + if (present(nread)) field_shape(:2) = nread(:2) - if (size_mismatch) then - write (msg, '("'// hdr //': size(start) ", i0, " and/or size(nread) ", & - i0, " do not match ndims ", i0)') size(start), size(nread), ndims - call MOM_error(FATAL, trim(msg)) + rc = nf90_get_var(ncid, varid, var, field_start, field_nread) + + deallocate(field_start) + deallocate(field_nread) + deallocate(field_shape) + deallocate(field_dimids) + else + rc = nf90_get_var(ncid, varid, var) endif - ! NOTE: We could check additional information here (type, size, ...) - rc = nf90_get_var(ncid, varid, var, start, nread) if (rc /= NF90_NOERR) call MOM_error(FATAL, hdr // trim(nf90_strerror(rc)) //& " Difficulties reading "//trim(varname)//" from "//trim(filename)) From 56401b637942c171968cba3af309fcafa7019c63 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 22 Dec 2021 09:34:18 -0500 Subject: [PATCH 53/73] +Add MOM_check_scaling.F90 and MOM_scaling_check.F90 Added two new modules, the MOM6-specific MOM_check_scaling.F90 and the generic framework module MOM_scaling_check.F90, to assess the uniqueness of the unit scaling factors for all of the variables used by MOM6. If there are overlaps in scaling factors for different units, this also identifies and suggests alternate scaling factors with less overlaps. This commit includes the introduction of the new publicly visible routines check_scaling_factors(), scales_to_powers() and check_MOM6_scaling_factors. This new capability does not do anything for sufficiently low levels of model verbosity, and it is silent if the scaling factors are unique, or if less than 2 dimensions are being rescaled. All answers and output files are bitwise identical, but there can be additional messages to stdout. --- src/core/MOM.F90 | 3 + src/core/MOM_check_scaling.F90 | 221 +++++++++++++++++ src/framework/MOM_scaling_check.F90 | 353 ++++++++++++++++++++++++++++ 3 files changed, 577 insertions(+) create mode 100644 src/core/MOM_check_scaling.F90 create mode 100644 src/framework/MOM_scaling_check.F90 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c36c0545e1..4a82eac903 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -56,6 +56,7 @@ module MOM use MOM_ALE_sponge, only : rotate_ALE_sponge, update_ALE_sponge_field use MOM_barotropic, only : Barotropic_CS use MOM_boundary_update, only : call_OBC_register, OBC_register_end, update_OBC_CS +use MOM_check_scaling, only : check_MOM6_scaling_factors use MOM_coord_initialization, only : MOM_initialize_coord use MOM_diabatic_driver, only : diabatic, diabatic_driver_init, diabatic_CS, extract_diabatic_member use MOM_diabatic_driver, only : adiabatic, adiabatic_driver_init, diabatic_driver_end @@ -2285,6 +2286,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif ! dG_in is retained for now so that it can be used with write_ocean_geometry_file() below. + if (is_root_PE()) call check_MOM6_scaling_factors(CS%GV, US) + call callTree_waypoint("grids initialized (initialize_MOM)") call MOM_timing_init(CS) diff --git a/src/core/MOM_check_scaling.F90 b/src/core/MOM_check_scaling.F90 new file mode 100644 index 0000000000..b707b65bc9 --- /dev/null +++ b/src/core/MOM_check_scaling.F90 @@ -0,0 +1,221 @@ +!> This module is used to check the scaling factors used by the MOM6 ocean model +module MOM_check_scaling + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, assert, MOM_get_verbosity +use MOM_scaling_check, only : check_scaling_factors, scales_to_powers +use MOM_unit_scaling, only : unit_scale_type +use MOM_verticalGrid, only : verticalGrid_type + +implicit none ; private + +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. + +public check_MOM6_scaling_factors + +contains + +!> Evaluate whether the dimensional scaling factors provide unique tests for all of the combinations +!! of dimensions that are used in MOM6 (or perhaps widely used), and if they are not unique, explore +!! whether another combination of scaling factors can be found that is unique or has less common +!! cases with coinciding scaling. +subroutine check_MOM6_scaling_factors(GV, US) + type(verticalGrid_type), pointer :: GV !< The container for vertical grid data + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + + ! Local variables + integer, parameter :: ndims = 6 ! The number of rescalable dimensional factors. + real, dimension(ndims) :: scales ! An array of scaling factors for each of the basic units. + integer, dimension(ndims) :: scale_pow2 ! The powers of 2 that give each element of scales. + character(len=2), dimension(ndims) :: key + ! character(len=128) :: mesg, msg_frag + integer, allocatable :: weights(:) + character(len=80), allocatable :: descriptions(:) + ! logical :: verbose, very_verbose + integer :: n, ns, max_pow + + ! Set the names and scaling factors of the dimensions being rescaled. + key(:) = ["Z", "H", "L", "T", "R", "Q"] + scales(:) = (/ US%Z_to_m, GV%H_to_MKS, US%L_to_m, US%T_to_s, US%R_to_kg_m3, US%Q_to_J_kg /) + call scales_to_powers(scales, scale_pow2) + max_pow = 40 ! 60 + + ! The first call is just to find out how many elements are in the list of scaling combinations. + call compose_dimension_list(ns, descriptions, weights) + + allocate(descriptions(ns)) + do n=1,ns ; descriptions(n) = "" ; enddo + allocate(weights(ns), source=0) + ! This call records all the list of powers, the descriptions, and their weights. + call compose_dimension_list(ns, descriptions, weights) + + call check_scaling_factors("MOM6", descriptions, weights, key, scale_pow2, max_pow) + + deallocate(weights) + deallocate(descriptions) + +end subroutine check_MOM6_scaling_factors + + +!> This routine composes a list of the commonly used dimensional scaling factors in the MOM6 +!! code, along with weights reflecting the frequency of their occurrence in the MOM6 code or +!! other considerations of how likely the variables are be used. +subroutine compose_dimension_list(ns, des, wts) + integer, intent(out) :: ns !< The running sum of valid descriptions + character(len=*), allocatable, intent(inout) :: des(:) !< The unit descriptions that have been converted + integer, allocatable, intent(inout) :: wts(:) !< A list of the integer weights for each scaling factor, + !! perhaps the number of times it occurs in the MOM6 code. + + ns = 0 + ! Accumulate a list of units used in MOM6, in approximate descending order of frequency of occurrence. + call add_scaling(ns, des, wts, "[H ~> m or kg m-2]", 1239) ! Layer thicknesses + call add_scaling(ns, des, wts, "[Z ~> m]", 660) ! Depths and vertical distance + call add_scaling(ns, des, wts, "[L T-1 ~> m s-1]", 506) ! Horizontal velocities + call add_scaling(ns, des, wts, "[R ~> kg m-3]", 356) ! Densities + call add_scaling(ns, des, wts, "[T-1 ~> s-1]", 247) ! Rates + call add_scaling(ns, des, wts, "[T ~> s]", 237) ! Time intervals + call add_scaling(ns, des, wts, "[R L2 T-2 ~> Pa]", 231) ! Dynamic pressure + ! call add_scaling(ns, des, wts, "[R L2 T-2 ~> J m-3]") ! Energy density + call add_scaling(ns, des, wts, "[Z2 T-1 ~> m2 s-1]", 181) ! Vertical viscosities and diffusivities + call add_scaling(ns, des, wts, "[H L2 ~> m3 or kg]", 174) ! Cell volumes or masses + call add_scaling(ns, des, wts, "[H L2 T-1 ~> m3 s-1 or kg s-1]", 163) ! Volume or mass transports + call add_scaling(ns, des, wts, "[L T-2 ~> m s-2]", 136) ! Horizontal accelerations + call add_scaling(ns, des, wts, "[L ~> m]", 107) ! Horizontal distances + call add_scaling(ns, des, wts, "[Z T-1 ~> m s-1]", 104) ! Friction velocities and viscous coupling + call add_scaling(ns, des, wts, "[H-1 ~> m-1 or m2 kg-1]", 89) ! Inverse cell thicknesses + call add_scaling(ns, des, wts, "[L2 T-2 ~> m2 s-2]", 88) ! Resolved kinetic energy per unit mass + call add_scaling(ns, des, wts, "[R Z3 T-2 ~> J m-2]", 85) ! Integrated turbulent kinetic energy density + call add_scaling(ns, des, wts, "[L2 T-1 ~> m2 s-1]", 78) ! Horizontal viscosity or diffusivity + call add_scaling(ns, des, wts, "[T-2 ~> s-2]", 69) ! Squared shears and buoyancy frequency + call add_scaling(ns, des, wts, "[H L ~> m2 or kg m-1]", 68) ! Lateral cell face areas + call add_scaling(ns, des, wts, "[L2 ~> m2]", 67) ! Horizontal areas + + call add_scaling(ns, des, wts, "[R-1 ~> m3 kg-1]", 61) ! Specific volumes + call add_scaling(ns, des, wts, "[Q R Z T-1 ~> W m-2]", 62) ! Vertical heat fluxes + call add_scaling(ns, des, wts, "[Z-1 ~> m-1]", 60) ! Inverse vertical distances + call add_scaling(ns, des, wts, "[L2 Z-1 T-2 ~> m s-2]", 57) ! Gravitational acceleration + call add_scaling(ns, des, wts, "[R Z T-1 ~> kg m-2 s-1]", 52) ! Vertical mass fluxes + call add_scaling(ns, des, wts, "[H T-1 ~> m s-1 or kg m-2 s-1]", 51) ! Vertical thickness fluxes + call add_scaling(ns, des, wts, "[R Z3 T-3 ~> W m-2]", 45) ! Integrated turbulent kinetic energy sources + call add_scaling(ns, des, wts, "[R Z ~> kg m-2]", 42) ! Layer or column mass loads + call add_scaling(ns, des, wts, "[Z3 T-3 ~> m3 s-3]", 33) ! Integrated turbulent kinetic energy sources + call add_scaling(ns, des, wts, "[H2 ~> m2 or kg2 m-4]", 35) ! Squared layer thicknesses + call add_scaling(ns, des, wts, "[Z2 T-2 ~> m2 s-2]", 33) ! Turbulent kinetic energy + call add_scaling(ns, des, wts, "[L-1 ~> m-1]", 32) ! Inverse horizontal distances + call add_scaling(ns, des, wts, "[R L Z T-2 ~> Pa]", 27) ! Wind stresses + call add_scaling(ns, des, wts, "[T2 L-2 ~> s2 m-2]", 33) ! Inverse velocities squared + call add_scaling(ns, des, wts, "[R Z L2 T-2 ~> J m-2]", 25) ! Integrated energy + ! call add_scaling(ns, des, wts, "[R L2 Z T-2 ~> Pa m]") ! Depth integral of pressures (25) + call add_scaling(ns, des, wts, "[Z L2 T-2 ~> m3 s-2]", 25) ! Integrated energy + call add_scaling(ns, des, wts, "[H R ~> kg m-2 or kg2 m-5]", 24) ! Layer-integrated density + call add_scaling(ns, des, wts, "[L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]", 20) ! pbce or gtot + call add_scaling(ns, des, wts, "[L-1 T-1 ~> m-1 s-1]", 19) ! Laplacian of velocity + + call add_scaling(ns, des, wts, "[L4 T-1 ~> m4 s-1]", 18) ! Biharmonic viscosity + call add_scaling(ns, des, wts, "[Z L T-1 ~> m2 s-1]", 17) ! Layer integrated velocities + call add_scaling(ns, des, wts, "[Z L-1 ~> nondim]", 15) ! Slopes + call add_scaling(ns, des, wts, "[Z L2 ~> m3]", 14) ! Diagnostic volumes + call add_scaling(ns, des, wts, "[H L T-1 ~> m2 s-1 or kg m-1 s-1]", 12) ! Layer integrated velocities + call add_scaling(ns, des, wts, "[L2 T-3 ~> m2 s-3]", 14) ! Buoyancy flux or MEKE sources [L2 T-3 ~> W kg-1] + call add_scaling(ns, des, wts, "[Z2 ~> m2]", 12) ! Squared vertical distances + call add_scaling(ns, des, wts, "[R Z L2 T-1 ~> kg s-1]", 12) ! Mass fluxes + call add_scaling(ns, des, wts, "[L-2 ~> m-2]", 12) ! Inverse areas + call add_scaling(ns, des, wts, "[L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1]", 11) ! Gravitational acceleration over density + call add_scaling(ns, des, wts, "[Z T-2 ~> m s-2]", 10) ! Buoyancy differences or their derivatives + ! Could also add [Z T-2 degC-1 ~> m s-2 degC-1] or [Z T-2 ppt-1 ~> m s-2 ppt-1] + call add_scaling(ns, des, wts, "[R Z L2 T-3 ~> W m-2]", 10) ! Energy sources, including for MEKE + call add_scaling(ns, des, wts, "[L3 ~> m3]", 10) ! Metric dependent constants for viscosity + call add_scaling(ns, des, wts, "[Z-2 ~> m-2]", 9) ! Inverse of denominator in some weighted averages + call add_scaling(ns, des, wts, "[H-2 ~> m-2 or m4 kg-2]", 9) ! Mixed layer local work variables + call add_scaling(ns, des, wts, "[Z L2 T-1 ~> m3 s-1]", 9) ! Overturning (GM) streamfunction + call add_scaling(ns, des, wts, "[L2 Z-2 T-2 ~> s-2]", 9) ! Buoyancy frequency in some params. + call add_scaling(ns, des, wts, "[Q R Z ~> J m-2]", 8) ! time-integrated frazil heat flux + call add_scaling(ns, des, wts, "[Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1]", 7) ! (TKE_to_Kd) + call add_scaling(ns, des, wts, "[Q degC-1 ~> J kg-1 degC-1]", 7) ! Heat capacity + + call add_scaling(ns, des, wts, "[R Z2 T-2 ~> J m-3]", 6) ! Potential energy height derivatives + call add_scaling(ns, des, wts, "[R Z3 T-2 H-1 ~> J m-3 or J kg-1]", 7) ! Partial derivatives of energy + call add_scaling(ns, des, wts, "[R L2 T-2 Z-1 ~> Pa m-1]", 7) ! Converts depth to pressure + call add_scaling(ns, des, wts, "[L4 Z-1 T-1 ~> m3 s-1]", 7) ! Rigidity of ice + call add_scaling(ns, des, wts, "[H L2 T-3 ~> m3 s-3]", 9) ! Kinetic energy diagnostics + call add_scaling(ns, des, wts, "[H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]", 6) ! Layer potential vorticity + call add_scaling(ns, des, wts, "[R Z2 T-3 ~> W m-3]", 3) ! Kinetic energy dissipation rates + call add_scaling(ns, des, wts, "[Z2 L-2 ~> 1]", 1) ! Slopes squared + call add_scaling(ns, des, wts, "[Z H-1 ~> nondim or m3 kg-1]", 6) ! Thickness to height conversion + call add_scaling(ns, des, wts, "[Pa T2 R-1 L-2 ~> 1]", 6) ! Pressure conversion factor + ! Could also add [m T2 R-1 L-2 ~> m Pa-1] + ! Could also add [degC T2 R-1 L-2 ~> degC Pa-1] + call add_scaling(ns, des, wts, "[R H-1 ~> kg m-4 or m-1]", 5) ! Vertical density gradients + call add_scaling(ns, des, wts, "[R L4 T-4 ~> Pa m2 s-2]", 4) ! Integral in geopotential of pressure + call add_scaling(ns, des, wts, "[L Z-1 ~> nondim]", 4) ! Inverse slopes + call add_scaling(ns, des, wts, "[L-3 ~> m-3]", 4) ! Metric dependent constants for viscosity + call add_scaling(ns, des, wts, "[H T2 L-1 ~> s2 or kg s2 m-3]", 4) ! BT_cont_type face curvature fit + call add_scaling(ns, des, wts, "[H L-1 ~> nondim or kg m-3]", 4) ! BT_cont_type face curvature fit + call add_scaling(ns, des, wts, "[kg H-1 L-2 ~> kg m-3 or 1]", 20) ! Diagnostic conversions to mass + ! Could also add [m3 H-1 L-2 ~> 1 or m3 kg-1] + call add_scaling(ns, des, wts, "[Z T-2 R-1 ~> m4 s-2 kg-1]", 9) ! Gravitational acceleration over density + call add_scaling(ns, des, wts, "[R Z L4 T-3 ~> kg m2 s-3]", 9) ! MEKE fluxes + call add_scaling(ns, des, wts, "[R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1]", 3) ! Thickness to pressure conversion + + call add_scaling(ns, des, wts, "[R-1 Z-1 ~> m2 kg-1]", 3) ! Inverse of column mass + call add_scaling(ns, des, wts, "[L4 ~> m4]", 3) ! Metric dependent constants for viscosity + call add_scaling(ns, des, wts, "[T-1 Z-1 ~> s-1 m-1]", 2) ! Barotropic PV, for some options + call add_scaling(ns, des, wts, "[R Z2 T-1 ~> J s m-3]", 2) ! River mixing term [R Z2 T-1 ~> Pa s] + call add_scaling(ns, des, wts, "[degC Q-1 ~> kg degC J-1]", 2) ! Inverse heat capacity + ! Could add call add_scaling(ns, des, wts, "[Q-1 ~> kg J-1]", 1) ! Inverse heat content + call add_scaling(ns, des, wts, "[L4 Z-2 T-1 ~> m2 s-1]", 2) ! Ice rigidity term + call add_scaling(ns, des, wts, "[R Z-1 ~> kg m-4]", 3) ! Vertical density gradient + call add_scaling(ns, des, wts, "[R Z L2 ~> kg]", 3) ! Depth and time integrated mass fluxes + call add_scaling(ns, des, wts, "[R L2 T-3 ~> W m-2]", 3) ! Depth integrated friction work + call add_scaling(ns, des, wts, "[ppt2 R-2 ~> ppt2 m6 kg-2]", 3) ! T / S gauge transformation + call add_scaling(ns, des, wts, "[R L-1 ~> kg m-4]", 2) ! Horizontal density gradient + ! Could add call add_scaling(ns, des, wts, "[H Z ~> m2 or kg m-1]", 2) ! Temporary variables + call add_scaling(ns, des, wts, "[Z3 R2 T-2 H-2 ~> kg2 m-5 s-2 or m s-2]", 2) ! Heating to PE change + call add_scaling(ns, des, wts, "[R2 L2 Z2 T-4 ~> Pa2]", 2) ! Squared wind stresses + call add_scaling(ns, des, wts, "[L-2 T-2 ~> m-2 s-2]", 2) ! Squared Laplacian of velocity + call add_scaling(ns, des, wts, "[T H Z-1 ~> s or s kg m-3]", 2) ! Time step times thickness conversion + call add_scaling(ns, des, wts, "[T H Z-1 R-1 ~> s m3 kg-1 or s]", 2) ! Time step over density with conversion + call add_scaling(ns, des, wts, "[H-3 ~> m-3 or m6 kg-3]", 1) ! A local term in ePBL + call add_scaling(ns, des, wts, "[H-4 ~> m-4 or m8 kg-4]", 1) ! A local term in ePBL + call add_scaling(ns, des, wts, "[H T Z-2 ~> s m-1 or kg s m-4]", 1) ! A local term in ePBL + + call add_scaling(ns, des, wts, "[H3 ~> m3 or kg3 m-6]", 1) ! Thickness cubed in a denominator + call add_scaling(ns, des, wts, "[H2 T-2 ~> m2 s-2 or kg2 m-4 s-2]", 1) ! Thickness times f squared + call add_scaling(ns, des, wts, "[H T2 R-1 Z-2 ~> m Pa-1 or s2 m-1]", 1) ! Pressure to thickness conversion + call add_scaling(ns, des, wts, "[L2 Z-2 ~> nondim]", 1) ! Inverse slope squared + call add_scaling(ns, des, wts, "[H R L2 T-2 ~> m Pa]", 1) ! Integral in thickness of pressure + call add_scaling(ns, des, wts, "[R T2 Z-1 ~> kg s2 m-4]", 1) ! Density divided by gravitational acceleration + +end subroutine compose_dimension_list + +!> Augment the count the valid unit descriptions, and add the provided description and its weight +!! to the end of the list if that list is allocated. +subroutine add_scaling(ns, descs, wts, scaling, weight) + integer, intent(inout) :: ns !< The running sum of valid descriptions. + character(len=*), allocatable, intent(inout) :: descs(:) !< The unit descriptions that have been converted + integer, allocatable, intent(inout) :: wts(:) !< A list of the integers for each scaling + character(len=*), intent(in) :: scaling !< The unit description that will be converted + integer, optional, intent(in) :: weight !< An optional weight or occurrence count + !! for this unit description, 1 by default. + + integer :: iend + + iend = index(scaling, "~>") + if (iend <= 1) then + call MOM_mesg("No scaling indicator ~> found for "//trim(scaling)) + else + ! Count and perhaps store this description and its weight. + ns = ns + 1 + if (allocated(descs)) descs(ns) = scaling + if (allocated(wts)) then + wts(ns) = 1 ; if (present(weight)) wts(ns) = weight + endif + endif + +end subroutine add_scaling + +end module MOM_check_scaling diff --git a/src/framework/MOM_scaling_check.F90 b/src/framework/MOM_scaling_check.F90 new file mode 100644 index 0000000000..e32e668b17 --- /dev/null +++ b/src/framework/MOM_scaling_check.F90 @@ -0,0 +1,353 @@ +!> This module is used to check the scaling factors used by the MOM6 ocean model +module MOM_scaling_check + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, assert, MOM_get_verbosity + +implicit none ; private + +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. + +public check_scaling_factors, scales_to_powers + +contains + +!> This subroutine does a checks whether the provided dimensional scaling factors give a unique +!! overall scaling for each of the combinations of units in description, and suggests a better +!! combination if it is not unique. However, this subroutine does nothing if the verbosity level +!! for this run is below 3. +subroutine check_scaling_factors(component, descs, weights, key, scales, max_powers) + character(len=*), intent(in) :: component !< The name of the component (e.g., MOM6) to use in messages + character(len=*), intent(in) :: descs(:) !< The descriptions for each combination of units + integer, intent(in) :: weights(:) !< A list of the weights for each described combination + character(len=*), intent(in) :: key(:) !< The key for the unit scaling + integer, intent(in) :: scales(:) !< The powers of 2 that give the scaling for each unit in key + integer, optional, intent(in) :: max_powers !< The maximum range of powers of 2 to search for + !! suggestions of better scaling factors, or 0 to avoid + !! suggesting improved factors. + + ! Local variables + integer, dimension(size(key)) :: next_scales, prev_scales, better_scales + character(len=512) :: mesg + character(len=64) :: msg_frag + integer, dimension(size(key), size(weights)) :: list + integer :: verbosity + logical :: same_key + integer :: orig_cost, test_cost, better_cost, prev_cost ! Various squared-weight mismatch costs. + integer :: better_dp ! The absolute change in powers with the better estimate. + integer :: ndims, ns, m, n, i, p, itt, max_itt, max_pow + + call assert((size(scales) == size(key)), "check_scaling_factors: Mismatched scales and key sizes.") + call assert((size(descs) == size(weights)), "check_scaling_factors: Mismatched descs and weights.") + + verbosity = MOM_get_verbosity() + ! Skip the rest of this routine if it would not write anything out. + if (verbosity < 3) return + + ndims = size(key) + ns = size(weights) + max_pow = 0 ; if (present(max_powers)) max_pow = max_powers + + list(:,:) = 0 + do n=1,ns + call encode_dim_powers(descs(n), key, list(:,n)) + enddo + + if (verbosity >= 7) then + write(mesg, '(I8)') ns + call MOM_mesg(trim(component)//": Extracted "//trim(adjustl(mesg))//" unit combinations from the list.") + mesg = "Dim Key: [" + do i=1,ndims ; mesg = trim(mesg)//" "//trim(key(i)) ; enddo + mesg = trim(mesg)//"]:" + call MOM_mesg(mesg) + do n=1,ns + call MOM_mesg(trim(component)//": Extracted ["//trim(int_array_msg(list(:,n)))//"] from "//trim(descs(n))) + enddo + + do n=1,ns ; do m=1,n-1 + same_key = .true. + do i=1,ndims ; if (list(i,n) /= list(i,m)) same_key = .false. ; enddo + if (same_key) then + call MOM_mesg(trim(component)//": The same powers occur for "//& + trim(descs(n))//" and "//trim(descs(m))//"." ) + endif + enddo ; enddo + endif + + orig_cost = non_unique_scales(scales, list, descs, weights, silent=(verbosity<4)) + + max_itt = 3*ndims ! Do up to 3 iterations for each rescalable dimension. + if (orig_cost /= 0) then + call MOM_mesg(trim(component)//": The dimensional scaling factors are not unique.") + prev_cost = orig_cost + prev_scales(:) = scales(:) + do itt=1,max_itt + ! Iterate to find a better solution. + better_scales(:) = prev_scales(:) + better_cost = prev_cost + better_dp = 0 + do i=1,ndims + if (scales(i) == 0) cycle ! DO not optimize unscaled dimensions. + next_scales(:) = prev_scales(:) + do p=-max_pow,max_pow + if ((p==0) .or. (p==prev_scales(i))) cycle + next_scales(i) = p + test_cost = non_unique_scales(next_scales, list, descs, weights, silent=.true.) + if ((test_cost < better_cost) .or. & + ((test_cost == better_cost) .and. (abs(p-prev_scales(i)) < better_dp))) then + ! This is a better scaling or has the same weighted mismatches but smaller + ! changes in rescaling factors, so it could be the next guess. + better_scales(:) = next_scales(:) + better_cost = test_cost + better_dp = abs(p - prev_scales(i)) + endif + enddo + enddo + if (better_cost < prev_cost) then + ! Store the new best guess and try again. + prev_scales(:) = better_scales(:) + prev_cost = better_cost + else ! No further optimization is possible. + exit + endif + if (better_cost == 0) exit + if (verbosity >= 7) then + write(mesg, '("Iteration ",I2," scaling cost reduced from ",I8," with original scales to ", I8)') & + itt, orig_cost, better_cost + call MOM_mesg(trim(component)//": "//trim(mesg)//" with revised scaling factors.") + endif + enddo + if (prev_cost < orig_cost) then + test_cost = non_unique_scales(prev_scales, list, descs, weights, silent=(verbosity<4)) + mesg = trim(component)//": Suggested improved scales: " + do i=1,ndims ; if ((prev_scales(i) /= scales(i)) .and. (scales(i) /= 0)) then + write(msg_frag, '(I3)') prev_scales(i) + mesg = trim(mesg)//" "//trim(key(i))//"_RESCALE_POWER = "//trim(adjustl(msg_frag)) + endif ; enddo + call MOM_mesg(mesg) + + write(mesg, '(I8)') orig_cost + write(msg_frag, '(I8)') test_cost + mesg = trim(component)//": Scaling overlaps reduced from "//trim(adjustl(mesg))//& + " with original scales to "//trim(adjustl(msg_frag))//" with suggested scales." + call MOM_mesg(mesg) + endif + + endif + +end subroutine check_scaling_factors + +!> Convert a unit scaling descriptor into an array of the dimensions of powers given in the key +subroutine encode_dim_powers(scaling, key, dim_powers) + + character(len=*), intent(in) :: scaling !< The unit description that will be converted + character(len=*), dimension(:), intent(in) :: key(:) !< The key for the unit scaling + integer, dimension(size(key)), intent(out) :: dim_powers !< The dimensions in scaling of each + !! element of they key. + + ! Local variables + character(len=:), allocatable :: actstr ! The full active remaining string to be parsed. + character(len=:), allocatable :: fragment ! The space-delimited fragment being parsed. + character(len=:), allocatable :: dimnm ! The probable dimension name + character(len=11) :: numbers ! The list of characters that could make up the exponent. + ! character(len=128) :: mesg + integer :: istart, iend, ieq, ief, ipow ! Positions in strings. + integer :: dp ! The power for this dimension. + integer :: ndim ! The number of dimensional scaling factors to consider. + integer :: n + + dim_powers(:) = 0 + + iend = index(scaling, "~>") - 1 + if (iend < 1) return + + ! Parse the key. + ndim = size(key) + numbers = "-0123456789" + + ! Strip away any leading square brace. + istart = index(scaling(:iend), "[") + 1 + ! If there is an "=" in the string, start after this. + ieq = index(scaling(istart:iend), "=", back=.true.) + if (ieq > 0) istart = istart + ieq + + ! Set up the active string to work on. + actstr = trim(adjustl(scaling(istart:iend))) + do ! Loop over each of the elements in the unit scaling descriptor. + if (len_trim(actstr) == 0) exit + ief = index(actstr, " ") - 1 + if (ief <= 0) ief = len_trim(actstr) + fragment = actstr(:ief) + ipow = scan(fragment, "-") + if (ipow == 0) ipow = scan(fragment, numbers) + + if (ipow == 0) then ! There is no exponent + dimnm = fragment + dp = 1 + ! call MOM_mesg("Parsing powerless fragment "//trim(fragment)//" from "//trim(scaling)) + else + if (verify(fragment(ipow:), numbers) == 0) then + read(fragment(ipow:),*) dp + dimnm = fragment(:ipow-1) + ! write(mesg, '(I3)') dp + ! call MOM_mesg("Parsed fragment "//trim(fragment)//" from "//trim(scaling)//& + ! " as "//trim(dimnm)//trim(adjustl(mesg))) + else + dimnm = fragment + dp = 1 + ! call MOM_mesg("Unparsed fragment "//trim(fragment)//" from "//trim(scaling)) + endif + endif + + do n=1,ndim + if (trim(dimnm) == trim(key(n))) then + dim_powers(n) = dim_powers(n) + dp + exit + endif + enddo + + ! Remove the leading fragment that has been parsed from actstr + actstr = trim(adjustl(actstr(ief+1:))) + enddo + +end subroutine encode_dim_powers + +!> Find the integer power of two that describe each of the scaling factors, or return 0 for +!! scaling factors that are not exceptionally close to an integer power of 2. +subroutine scales_to_powers(scale, pow2) + real, intent(in) :: scale(:) !< The scaling factor for each dimension + integer, intent(out) :: pow2(:) !< The exact powers of 2 for each scale, or 0 for non-exact powers of 2. + + real :: log2_sc ! The log base 2 of an element of scale + integer :: n, ndim + + ndim = size(scale) + + ! Find the integer power of two for the scaling factors, but skip the analysis of any factors + ! that are not close enough to being integer powers of 2. + do n=1,ndim + if (abs(scale(n)) > 0.0) then + log2_sc = log(abs(scale(n))) / log(2.0) + else + log2_sc = 0.0 + endif + if (abs(log2_sc - nint(log2_sc)) < 1.0e-6) then + ! This is close to an integer power of two. + pow2(n) = nint(log2_sc) + else + ! This is not being scaled by an integer power of 2, so return 0. + pow2(n) = 0 + endif + enddo + +end subroutine scales_to_powers + +!> Determine from the list of scaling factors and the unit combinations that are in use whether +!! all these combinations scale uniquely. +integer function non_unique_scales(scales, list, descs, weights, silent) + integer, intent(in) :: scales(:) !< The power of 2 that gives the scaling factor for each dimension + integer, intent(in) :: list(:,:) !< A list of the integers for each scaling + character(len=*), intent(in) :: descs(:) !< The unit descriptions that have been converted + integer, intent(in) :: weights(:) !< A list of the weights for each scaling + logical, optional, intent(in) :: silent !< If present and true, do not write any output. + + ! Local variables + integer, dimension(size(weights)) :: res_pow ! The net rescaling power for each combination. + integer, dimension(size(weights)) :: wt_merge ! The merged weights of scaling factors with common powers + ! for the dimensions being tested. + logical :: same_key, same_scales, verbose + character(len=256) :: mesg + integer :: nonzero_count ! The number of non-zero scaling factors + integer :: ndim ! The number of dimensional scaling factors to work with + integer :: i, n, m, ns + + verbose = .true. ; if (present(silent)) verbose = .not.silent + + ndim = size(scales) + ns = size(descs) + call assert((size(scales) == size(list, 1)), "non_unique_scales: Mismatched scales and list sizes.") + call assert((size(descs) == size(list, 2)), "non_unique_scales: Mismatched descs and list sizes.") + call assert((size(descs) == size(weights)), "non_unique_scales: Mismatched descs and weights.") + + ! Return .true. if all scaling powers are 0, or there is only one scaling factor in use. + nonzero_count = 0 ; do n=1,ndim ; if (scales(n) /= 0) nonzero_count = nonzero_count + 1 ; enddo + if (nonzero_count <= 1) return + + ! Figure out which unit combinations are unique for the set of dimensions and scaling factors + ! that are being tested, and combine the weights for scaling factors. + wt_merge(:) = weights(:) + do n=1,ns ; do m=1,n-1 + same_key = .true. + same_scales = .true. + do i=1,ndim + if (list(i,n) /= list(i,m)) same_key = .false. + if ((scales(i) /= 0) .and. (list(i,n) /= list(i,m))) same_scales = .false. + enddo + if (same_key .or. same_scales) then + if (wt_merge(n) > wt_merge(m)) then + wt_merge(n) = wt_merge(n) + wt_merge(m) + wt_merge(m) = 0 + else + wt_merge(m) = wt_merge(m) + wt_merge(n) + wt_merge(n) = 0 + endif + endif + if (wt_merge(n) == 0) exit ! Go to the next value of n. + enddo ; enddo + + do n=1,ns + res_pow(n) = 0 + do i=1,ndim + res_pow(n) = res_pow(n) + scales(i) * list(i,n) + enddo + enddo + + ! Determine the weighted cost of non-unique scaling factors. + non_unique_scales = 0 + do n=1,ns ; if (wt_merge(n) > 0) then ; do m=1,n-1 ; if (wt_merge(m) > 0) then + if (res_pow(n) == res_pow(m)) then + ! Use the product of the weights as the cost, as this should be vaguely proportional to + ! the likelihood that these factors would be combined in an expression. + non_unique_scales = min(non_unique_scales + wt_merge(n) * wt_merge(m), 99999999) + if (verbose) then + write(mesg, '(I8)') res_pow(n) + call MOM_mesg("The factors "//trim(descs(n))//" and "//trim(descs(m))//" both scale to "//& + trim(adjustl(mesg))//" for the given powers.") + + ! call MOM_mesg("Powers ["//trim(int_array_msg(list(:,n)))//"] and ["//& + ! trim(int_array_msg(list(:,m)))//"] with rescaling by ["//& + ! trim(int_array_msg(scales))//"]") + endif + endif + endif ; enddo ; endif ; enddo + +end function non_unique_scales + +!> Return a string the elements of an array of integers +function int_array_msg(array) + integer, intent(in) :: array(:) !< The array whose values are to be written. + character(len=16*size(array)) :: int_array_msg + + character(len=12) :: msg_frag + integer :: i, ni + ni = size(array) + + int_array_msg = "" + if (ni < 1) return + + do i=1,ni + write(msg_frag, '(I8)') array(i) + msg_frag = adjustl(msg_frag) + if (i == 1) then + int_array_msg = trim(msg_frag) + else + int_array_msg = trim(int_array_msg)//" "//trim(msg_frag) + endif + enddo +end function int_array_msg + +end module MOM_scaling_check From 75bf521e29e3434965b44cea288404bb0be341af Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 24 Jan 2022 17:04:25 -0500 Subject: [PATCH 54/73] +Move MOM_scaling_check.F90 to MOM_unique_scales.F90 Renamed the framework module MOM_scaling_check.F90 to MOM_unique_scales.F90 to help differentiate it from MOM_check_scaling.F90, and renamed the subroutine check_scaling_factors() as check_scaling_uniqueness(). Also added _Dimensional_consistency.dox to describe the dimensional consistency testing. This commit should address the issues raised in the review of MOM6 PR #49. All answers and output are bitwise identical. --- src/core/MOM_check_scaling.F90 | 6 +- ...caling_check.F90 => MOM_unique_scales.F90} | 13 +-- src/framework/_Dimensional_consistency.dox | 85 +++++++++++++++++++ 3 files changed, 95 insertions(+), 9 deletions(-) rename src/framework/{MOM_scaling_check.F90 => MOM_unique_scales.F90} (97%) create mode 100644 src/framework/_Dimensional_consistency.dox diff --git a/src/core/MOM_check_scaling.F90 b/src/core/MOM_check_scaling.F90 index b707b65bc9..55bd471fee 100644 --- a/src/core/MOM_check_scaling.F90 +++ b/src/core/MOM_check_scaling.F90 @@ -1,10 +1,10 @@ -!> This module is used to check the scaling factors used by the MOM6 ocean model +!> This module is used to check the dimensional scaling factors used by the MOM6 ocean model module MOM_check_scaling ! This file is part of MOM6. See LICENSE.md for the license. use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, assert, MOM_get_verbosity -use MOM_scaling_check, only : check_scaling_factors, scales_to_powers +use MOM_unique_scales, only : check_scaling_uniqueness, scales_to_powers use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type @@ -53,7 +53,7 @@ subroutine check_MOM6_scaling_factors(GV, US) ! This call records all the list of powers, the descriptions, and their weights. call compose_dimension_list(ns, descriptions, weights) - call check_scaling_factors("MOM6", descriptions, weights, key, scale_pow2, max_pow) + call check_scaling_uniqueness("MOM6", descriptions, weights, key, scale_pow2, max_pow) deallocate(weights) deallocate(descriptions) diff --git a/src/framework/MOM_scaling_check.F90 b/src/framework/MOM_unique_scales.F90 similarity index 97% rename from src/framework/MOM_scaling_check.F90 rename to src/framework/MOM_unique_scales.F90 index e32e668b17..730d11adb0 100644 --- a/src/framework/MOM_scaling_check.F90 +++ b/src/framework/MOM_unique_scales.F90 @@ -1,5 +1,6 @@ -!> This module is used to check the scaling factors used by the MOM6 ocean model -module MOM_scaling_check +!> This module provides tools that can be used to check the uniqueness of the dimensional +!! scaling factors used by the MOM6 ocean model or other models +module MOM_unique_scales ! This file is part of MOM6. See LICENSE.md for the license. @@ -12,7 +13,7 @@ module MOM_scaling_check ! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units ! vary with the Boussinesq approximation, the Boussinesq variant is given first. -public check_scaling_factors, scales_to_powers +public check_scaling_uniqueness, scales_to_powers contains @@ -20,7 +21,7 @@ module MOM_scaling_check !! overall scaling for each of the combinations of units in description, and suggests a better !! combination if it is not unique. However, this subroutine does nothing if the verbosity level !! for this run is below 3. -subroutine check_scaling_factors(component, descs, weights, key, scales, max_powers) +subroutine check_scaling_uniqueness(component, descs, weights, key, scales, max_powers) character(len=*), intent(in) :: component !< The name of the component (e.g., MOM6) to use in messages character(len=*), intent(in) :: descs(:) !< The descriptions for each combination of units integer, intent(in) :: weights(:) !< A list of the weights for each described combination @@ -139,7 +140,7 @@ subroutine check_scaling_factors(component, descs, weights, key, scales, max_pow endif -end subroutine check_scaling_factors +end subroutine check_scaling_uniqueness !> Convert a unit scaling descriptor into an array of the dimensions of powers given in the key subroutine encode_dim_powers(scaling, key, dim_powers) @@ -350,4 +351,4 @@ function int_array_msg(array) enddo end function int_array_msg -end module MOM_scaling_check +end module MOM_unique_scales diff --git a/src/framework/_Dimensional_consistency.dox b/src/framework/_Dimensional_consistency.dox new file mode 100644 index 0000000000..0657724381 --- /dev/null +++ b/src/framework/_Dimensional_consistency.dox @@ -0,0 +1,85 @@ +/*! \page Dimensional_consistency Dimensional Consistency Testing + +\section section_Dimensional_consistency Dimensional Consistency Testing + + MOM6 uses a unique system for testing the dimensional consistency of all of +its expressions. The internal representations of dimensional variables are +rescaled by integer powers of 2 that depend on their units, with all input and +output being rescaled back to their original MKS units. By choosing different +powers of 2 for different units, the internal representations with different +units scale differently, so dimensionally inconsistent expressions will not +reproduce, but dimensionally inconsistent expressions give bitwise identical +results. So, for example, if horizontal lengths scale by a factor of 2^6=64, +and time is scaled by a factor of 2^4=16, horizontal velocities will scale by a +factor of 2^(6-4)=4. In this case, expressions that combine velocities, all +terms would scale by the same factor of 4. By contrast, if there were an +expression where a variable with units of length were added to one with the +units of a velocity, the results would scale inconsistently, and answers would +change with different scaling factors. + + What makes these integer powers of 2 special is the way that floating point +numbers are written as an O(1) mantissa times 2 raised to an integer exponent +between +/-1024. Multiplication by an integer power of 2 is just an integer +shift in the exponent, so as long as the model is not rescaled by an overly +large factor to encounter overflows and the model is not relying on automatic +underflows being converted to 0, all floating point operations can be carried +with one scale, and then rescaled to obtain identical answers. MOM6 has the +option to explicitly handle all relevant cases of underflows, and it can be +demonstrated to give identical answers when each of its units are scaled by +factors ranging from 2^-140 ~= 7.2e-43 to 2^140 ~= 1.4e42. + + When running with rescaling factors other than 2^0 = 1, there are some extra +array copies and multiplies of input fields or diagnostic output, so it is +slightly more efficient not to actively use the dimensional rescaling. For +production runs, we typically set all of the rescaling powers to 0, but for +debugging code problems, this rescaling can be an invaluable tool, especially +when combined with the very verbose runtime setting DEBUG=True in a MOM_input or +MOM_override file. Diffs of the output from runs with different scaling factors +readily highlights the earliest instances of differences, which can be used to +track down any dimensionally inconsistent expressions. Similarly, dimensional +inconsistencies in diagnostics is easily tracked down by comparing the output +from a pair of runs. + + All real variables in MOM6 should have comments describing their purpose, +along with their rescaled units and their mks counterparts with notation like +"! A velocity [L T-1 ~> m s-1]". If the units vary with the Boussinesq +approximation, the Boussinesq variant is given first. When variables are read +in, their dimensions are usually specified with a 'scale=' optional argument on +the MOM_get_param or MOM_read_data call, while the unscaling of diagnostics is +specified with a 'conversion=' factor. In both cases, these arguments it next +to a text string specifying the variable's units, which can then be check easily +for self-consistency. + + Currently in MOM6, the following dimensions have unique scaling, along with +the notation used to describe these variables in comments: + +\li Time, scaled by 2^T_RESCALE_POWER, denoted as [T ~> s] +\li Horizontal length, scaled by 2^L_RESCALE_POWER, denoted as [L ~> m] +\li Vertical height, scaled by 2^Z_RESCALE_POWER, denoted as [Z ~> m] +\li Vertical thickness, scaled by 2^H_RESCALE_POWER, denoted as [H ~> m or kg m-2] +\li Density, scaled by 2^R_RESCALE_POWER, denoted as [R ~> kg m-3] +\li Enthalpy (or heat content), scaled by 2^Q_RESCALE_POWER, denoted as [Q ~> J kg-1] + + These rescaling capabilities are also used by the SIS2 sea ice model, but it +does uses a non-Boussinesq mass scale of [R Z ~> kg m-2] for ice thicknesses, +rather than having a separate scaling factor (of [H ~> m or kg m-2]) that varies +between the Boussinesq and non-Boussinesq modes like MOM6 does. The actual +powers used in the scaling are specified separately for MOM6 and SIS2 and +need not be the same. + + Each of these units can be scaled in separate test runs, or all of them can be +rescaled simultaneously. In the latter case, MOM_unique_scales.F90 provides +tools to evaluate whether the specific combinations of units used by a model +scale by unique powers, and it can suggest scaling factors that provides unique +combinations of rescaling factors for the dimensions being tested, using a +cost-function based on the frequency with which units are used in the model (and +specified inside of MOM_check_scaling.F90), with a cost going as the product of +the frequency of units that resolve to the same scaling factor. + + A separate set of scaling factors could also be used for different chemical +tracer concentrations, for example. In this case, the tools in +MOM_unique_scales.F90 could still be used, but there would need to be a separate +equivalent of the unit_scaling_type with variables that are appropriate to the +units of the tracers. + +*/ From 64f432fcb5b962a890330788fc11c80572296fd1 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 15 Feb 2022 22:10:51 -0500 Subject: [PATCH 55/73] Diabatic driver: energetic_PBL -> ePBL, flag check Pointers to the diabatic driver's energetic PBL field are now only associated when `use_energetic_PBL` is true. The `energetic_PBL` field was also renamed to `ePBL` to avoid potential conflict with the `energetic_PBL` subroutine. Thanks to Alper Altuntas for detecting this issue and the proposed fix. Co-Authored-By: Alper Altuntas --- .../vertical/MOM_diabatic_driver.F90 | 21 +++++++++---------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 5eaca3c275..7b180f1d65 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -234,7 +234,7 @@ module MOM_diabatic_driver type(oda_incupd_CS), pointer :: oda_incupd_CSp => NULL() !< Control structure for a child module type(bulkmixedlayer_CS) :: bulkmixedlayer !< Bulk mixed layer control struct type(CVMix_conv_CS) :: CVMix_conv !< CVMix convection control struct - type(energetic_PBL_CS) :: energetic_PBL !< Energetic PBL control struct + type(energetic_PBL_CS) :: ePBL !< Energetic PBL control struct type(entrain_diffusive_CS) :: entrain_diffusive !< Diffusive entrainment control struct type(geothermal_CS) :: geothermal !< Geothermal control struct type(int_tide_CS) :: int_tide !< Internal tide control struct @@ -838,15 +838,15 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + CS%ePBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then - call energetic_PBL_get_MLD(CS%energetic_PBL, Hml(:,:), G, US) + call energetic_PBL_get_MLD(CS%ePBL, Hml(:,:), G, US) call pass_var(Hml, G%domain, halo=1) ! If visc%MLD exists, copy ePBL's MLD into it if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) elseif (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL, visc%MLD, G, US) + call energetic_PBL_get_MLD(CS%ePBL, visc%MLD, G, US) call pass_var(visc%MLD, G%domain, halo=1) endif @@ -1375,15 +1375,15 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + CS%ePBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then - call energetic_PBL_get_MLD(CS%energetic_PBL, Hml(:,:), G, US) + call energetic_PBL_get_MLD(CS%ePBL, Hml(:,:), G, US) call pass_var(Hml, G%domain, halo=1) ! If visc%MLD exists, copy ePBL's MLD into it if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) elseif (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL, visc%MLD, G, US) + call energetic_PBL_get_MLD(CS%ePBL, visc%MLD, G, US) call pass_var(visc%MLD, G%domain, halo=1) endif @@ -2589,14 +2589,13 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, if (present(opacity_CSp)) opacity_CSp => CS%opacity if (present(optics_CSp)) optics_CSp => CS%optics if (present(KPP_CSp)) KPP_CSp => CS%KPP_CSp - if (present(energetic_PBL_CSp)) energetic_PBL_CSp => CS%energetic_PBL + if (present(energetic_PBL_CSp) .and. CS%use_energetic_PBL) energetic_PBL_CSp => CS%ePBL if (present(diabatic_aux_CSp)) diabatic_aux_CSp => CS%diabatic_aux_CSp ! Constants within diabatic_CS if (present(evap_CFL_limit)) evap_CFL_limit = CS%evap_CFL_limit if (present(minimum_forcing_depth)) minimum_forcing_depth = CS%minimum_forcing_depth if (present(diabatic_halo)) diabatic_halo = CS%halo_TS_diff - end subroutine extract_diabatic_member !> Routine called for adiabatic physics @@ -3487,7 +3486,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%use_bulkmixedlayer) & call bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS%bulkmixedlayer) if (CS%use_energetic_PBL) & - call energetic_PBL_init(Time, G, GV, US, param_file, diag, CS%energetic_PBL) + call energetic_PBL_init(Time, G, GV, US, param_file, diag, CS%ePBL) call regularize_layers_init(Time, G, GV, param_file, diag, CS%regularize_layers) @@ -3522,7 +3521,7 @@ subroutine diabatic_driver_end(CS) call diapyc_energy_req_end(CS%diapyc_en_rec_CSp) if (CS%use_energetic_PBL) & - call energetic_PBL_end(CS%energetic_PBL) + call energetic_PBL_end(CS%ePBL) call diabatic_aux_end(CS%diabatic_aux_CSp) From fc5253f73c34b2fafff0fe446d6e4cd75e317752 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 24 Jan 2022 14:07:37 -0500 Subject: [PATCH 56/73] (*)Correct memory declarations in MOM_regridding Corrected memory declarations in MOM_regridding.F90 in cases where the vertical size of the input and output grids are not the same. Although this is not know to have caused any particular problems, these inconsistencies could lead to segmentation faults in cases where the target grid (e.g., diagnostic output) is larger than the input grid (e.g., the model's native grid). In some cases, certain grid generation options were only written to work with the same size of input and output grids, and error handling has been added to these cases to gracefully bring down the model if they are used with different grid sizes. All answers are bitwise identical in the MOM6-examples test suite, but it is conceivable that this could correct subtle (memory-related) issues in some configurations. --- src/ALE/MOM_regridding.F90 | 108 +++++++++++++++++++++++-------------- 1 file changed, 67 insertions(+), 41 deletions(-) diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 94d7852851..dafd165245 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -3,7 +3,7 @@ module MOM_regridding ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_error_handler, only : MOM_error, FATAL, WARNING +use MOM_error_handler, only : MOM_error, FATAL, WARNING, assert use MOM_file_parser, only : param_file_type, get_param, log_param use MOM_io, only : file_exists, field_exists, field_size, MOM_read_data use MOM_io, only : verify_variable_units, slasher @@ -776,11 +776,11 @@ subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, frac_ type(regridding_CS), intent(in) :: CS !< Regridding control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after !! the last time step type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamical variables (T, S, ...) - real, dimension(SZI_(G),SZJ_(G), CS%nk), intent(inout) :: h_new !< New 3D grid consistent with target coordinate - real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in position of each interface + real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New 3D grid consistent with target coordinate + real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< The change in position of each interface real, dimension(SZI_(G),SZJ_(G)), optional, intent(in ) :: frac_shelf_h !< Fractional ice shelf coverage logical, optional, intent(in ) :: conv_adjust !< If true, do convective adjustment ! Local variables @@ -827,7 +827,7 @@ subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, frac_ end select ! type of grid #ifdef __DO_SAFETY_CHECKS__ - call check_remapping_grid(G, GV, h, dzInterface,'in regridding_main') + if (CS%nk == GV%ke) call check_remapping_grid(G, GV, h, dzInterface,'in regridding_main') #endif end subroutine regridding_main @@ -1086,13 +1086,14 @@ subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth + real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth !! [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: frac_shelf_h !< Fractional !! ice shelf coverage [nondim]. ! Local variables real :: nominalDepth, minThickness, totalThickness, dh ! Depths and thicknesses [H ~> m or kg m-2] - real, dimension(SZK_(GV)+1) :: zOld, zNew ! Coordinate interface heights [H ~> m or kg m-2] + real, dimension(SZK_(GV)+1) :: zOld ! Previous coordinate interface heights [H ~> m or kg m-2] + real, dimension(CS%nk+1) :: zNew ! New coordinate interface heights [H ~> m or kg m-2] integer :: i, j, k, nz logical :: ice_shelf @@ -1144,17 +1145,23 @@ subroutine build_zstar_grid( CS, G, GV, h, dzInterface, frac_shelf_h) call filtered_grid_motion( CS, nz, zOld, zNew, dzInterface(i,j,:) ) #ifdef __DO_SAFETY_CHECKS__ - dh=max(nominalDepth,totalThickness) - if (abs(zNew(1)-zOld(1))>(nz-1)*0.5*epsilon(dh)*dh) then + dh = max(nominalDepth,totalThickness) + if (abs(zNew(1)-zOld(1)) > (nz-1)*0.5*epsilon(dh)*dh) then write(0,*) 'min_thickness=',CS%min_thickness write(0,*) 'nominalDepth=',nominalDepth,'totalThickness=',totalThickness - write(0,*) 'dzInterface(1) = ',dzInterface(i,j,1),epsilon(dh),nz - do k=1,nz+1 + write(0,*) 'dzInterface(1) = ', dzInterface(i,j,1), epsilon(dh), nz, CS%nk + do k=1,min(nz,CS%nk)+1 write(0,*) k,zOld(k),zNew(k) enddo - do k=1,nz + do k=min(nz,CS%nk)+2,CS%nk+1 + write(0,*) k,zOld(nz+1),zNew(k) + enddo + do k=1,min(nz,CS%nk) write(0,*) k,h(i,j,k),zNew(k)-zNew(k+1),CS%coordinateResolution(k) enddo + do k=min(nz,CS%nk)+1,CS%nk + write(0,*) k, 0.0, zNew(k)-zNew(k+1), CS%coordinateResolution(k) + enddo call MOM_error( FATAL, & 'MOM_regridding, build_zstar_grid(): top surface has moved!!!' ) endif @@ -1183,14 +1190,15 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface ) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G), CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth + real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth !! [H ~> m or kg m-2] ! Local variables integer :: i, j, k integer :: nz real :: nominalDepth, totalThickness, dh - real, dimension(SZK_(GV)+1) :: zOld, zNew + real, dimension(SZK_(GV)+1) :: zOld ! Previous coordinate interface heights [H ~> m or kg m-2] + real, dimension(CS%nk+1) :: zNew ! New coordinate interface heights [H ~> m or kg m-2] nz = GV%ke @@ -1227,12 +1235,18 @@ subroutine build_sigma_grid( CS, G, GV, h, dzInterface ) write(0,*) 'min_thickness=',CS%min_thickness write(0,*) 'nominalDepth=',nominalDepth,'totalThickness=',totalThickness write(0,*) 'dzInterface(1) = ',dzInterface(i,j,1),epsilon(dh),nz,CS%nk - do k=1,nz+1 + do k=1,min(nz,CS%nk)+1 write(0,*) k,zOld(k),zNew(k) enddo - do k=1,CS%nk + do k=min(nz,CS%nk)+2,CS%nk+1 + write(0,*) k,zOld(nz+1),zNew(k) + enddo + do k=1,min(nz,CS%nk) write(0,*) k,h(i,j,k),zNew(k)-zNew(k+1),totalThickness*CS%coordinateResolution(k),CS%coordinateResolution(k) enddo + do k=min(nz,CS%nk)+1,CS%nk + write(0,*) k,0.0,zNew(k)-zNew(k+1),totalThickness*CS%coordinateResolution(k),CS%coordinateResolution(k) + enddo call MOM_error( FATAL, & 'MOM_regridding, build_sigma_grid: top surface has moved!!!' ) endif @@ -1266,22 +1280,23 @@ subroutine build_rho_grid( G, GV, US, h, tv, dzInterface, remapCS, CS, frac_shel !------------------------------------------------------------------------------ ! Arguments + type(regridding_CS), intent(in) :: CS !< Regridding control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, dimension(SZI_(G),SZJ_(G), SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface depth + real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth !! [H ~> m or kg m-2] type(remapping_CS), intent(in) :: remapCS !< The remapping control structure - type(regridding_CS), intent(in) :: CS !< Regridding control structure real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: frac_shelf_h !< Fractional ice !! shelf coverage [nondim] ! Local variables - integer :: nz + integer :: nz ! The number of layers in the input grid integer :: i, j, k real :: nominalDepth ! Depth of the bottom of the ocean, positive downward [H ~> m or kg m-2] - real, dimension(SZK_(GV)+1) :: zOld, zNew ! Old and new interface heights [H ~> m or kg m-2] + real, dimension(SZK_(GV)+1) :: zOld ! Previous coordinate interface heights [H ~> m or kg m-2] + real, dimension(CS%nk+1) :: zNew ! New coordinate interface heights [H ~> m or kg m-2] real :: h_neglect, h_neglect_edge ! Negligible thicknesses [H ~> m or kg m-2] real :: totalThickness ! Total thicknesses [H ~> m or kg m-2] #ifdef __DO_SAFETY_CHECKS__ @@ -1355,7 +1370,7 @@ subroutine build_rho_grid( G, GV, US, h, tv, dzInterface, remapCS, CS, frac_shel call filtered_grid_motion( CS, nz, zOld, zNew, dzInterface(i,j,:) ) #ifdef __DO_SAFETY_CHECKS__ - do k = 2,nz + do k=2,CS%nk if (zNew(k) > zOld(1)) then write(0,*) 'zOld=',zOld write(0,*) 'zNew=',zNew @@ -1380,12 +1395,18 @@ subroutine build_rho_grid( G, GV, US, h, tv, dzInterface, remapCS, CS, frac_shel write(0,*) 'min_thickness=',CS%min_thickness write(0,*) 'nominalDepth=',nominalDepth,'totalThickness=',totalThickness write(0,*) 'zNew(1)-zOld(1) = ',zNew(1)-zOld(1),epsilon(dh),nz - do k=1,nz+1 + do k=1,min(nz,CS%nk)+1 write(0,*) k,zOld(k),zNew(k) enddo + do k=min(nz,CS%nk)+2,CS%nk+1 + write(0,*) k,zOld(nz+1),zNew(k) + enddo do k=1,nz write(0,*) k,h(i,j,k),zNew(k)-zNew(k+1) enddo + do k=min(nz,CS%nk)+1,CS%nk + write(0,*) k, 0.0, zNew(k)-zNew(k+1), CS%coordinateResolution(k) + enddo call MOM_error( FATAL, & 'MOM_regridding, build_rho_grid: top surface has moved!!!' ) endif @@ -1416,10 +1437,10 @@ subroutine build_grid_HyCOM1( G, GV, US, h, tv, h_new, dzInterface, CS, frac_she !! coverage [nondim] ! Local variables - real, dimension(SZK_(GV)+1) :: z_col ! Source interface positions relative to the surface [H ~> m or kg m-2] + real, dimension(SZK_(GV)+1) :: z_col ! Source interface positions relative to the surface [H ~> m or kg m-2] + real, dimension(SZK_(GV)) :: p_col ! Layer center pressure in the input column [R L2 T-2 ~> Pa] real, dimension(CS%nk+1) :: z_col_new ! New interface positions relative to the surface [H ~> m or kg m-2] - real, dimension(SZK_(GV)+1) :: dz_col ! The realized change in z_col [H ~> m or kg m-2] - real, dimension(SZK_(GV)) :: p_col ! Layer center pressure [R L2 T-2 ~> Pa] + real, dimension(CS%nk+1) :: dz_col ! The realized change in z_col [H ~> m or kg m-2] integer :: i, j, k, nki real :: depth, nominalDepth real :: h_neglect, h_neglect_edge @@ -1496,10 +1517,10 @@ subroutine build_grid_adaptive(G, GV, US, h, tv, dzInterface, remapCS, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface depth + type(regridding_CS), intent(in) :: CS !< Regridding control structure + real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< The change in interface depth !! [H ~> m or kg m-2] type(remapping_CS), intent(in) :: remapCS !< The remapping control structure - type(regridding_CS), intent(in) :: CS !< Regridding control structure ! local variables integer :: i, j, k, nz ! indices and dimension lengths @@ -1512,6 +1533,9 @@ subroutine build_grid_adaptive(G, GV, US, h, tv, dzInterface, remapCS, CS) nz = GV%ke + call assert((GV%ke == CS%nk), "build_grid_adaptive is only written to work "//& + "with the same number of input and target layers.") + ! position surface at z = 0. zInt(:,:,1) = 0. @@ -1562,13 +1586,13 @@ subroutine build_grid_SLight(G, GV, US, h, tv, dzInterface, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Existing model thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: dzInterface !< Changes in interface position type(regridding_CS), intent(in) :: CS !< Regridding control structure + real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< Changes in interface position - real, dimension(SZK_(GV)+1) :: z_col ! Interface positions relative to the surface [H ~> m or kg m-2] - real, dimension(SZK_(GV)+1) :: z_col_new ! Interface positions relative to the surface [H ~> m or kg m-2] - real, dimension(SZK_(GV)+1) :: dz_col ! The realized change in z_col [H ~> m or kg m-2] - real, dimension(SZK_(GV)) :: p_col ! Layer center pressure [R L2 T-2 ~> Pa] + real, dimension(SZK_(GV)+1) :: z_col ! Source interface positions relative to the surface [H ~> m or kg m-2] + real, dimension(SZK_(GV)) :: p_col ! Layer center pressure in the input column [R L2 T-2 ~> Pa] + real, dimension(CS%nk+1) :: z_col_new ! New interface positions relative to the surface [H ~> m or kg m-2] + real, dimension(CS%nk+1) :: dz_col ! The realized change in z_col [H ~> m or kg m-2] ! Local variables real :: depth ! Depth of the ocean relative to the mean sea surface height in thickness units [H ~> m or kg m-2] @@ -1585,8 +1609,10 @@ subroutine build_grid_SLight(G, GV, US, h, tv, dzInterface, CS) nz = GV%ke - if (.not.CS%target_density_set) call MOM_error(FATAL, "build_grid_SLight : "//& - "Target densities must be set before build_grid_SLight is called.") + call assert((GV%ke == CS%nk), "build_grid_SLight is only written to work "//& + "with the same number of input and target layers.") + call assert(CS%target_density_set, "build_grid_SLight : "//& + "Target densities must be set before build_grid_SLight is called.") ! Build grid based on target interface densities do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 @@ -1691,13 +1717,13 @@ subroutine build_grid_arbitrary( G, GV, h, dzInterface, h_new, CS ) !------------------------------------------------------------------------------ ! Arguments - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(in) :: h !< Original layer thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G), SZK_(GV)+1), intent(inout) :: dzInterface !< The change in interface - !! depth [H ~> m or kg m-2] - real, intent(inout) :: h_new !< New layer thicknesses [H ~> m or kg m-2] - type(regridding_CS), intent(in) :: CS !< Regridding control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Original layer thicknesses [H ~> m or kg m-2] + type(regridding_CS), intent(in) :: CS !< Regridding control structure + real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< The change in interface + !! depth [H ~> m or kg m-2] + real, intent(inout) :: h_new !< New layer thicknesses [H ~> m or kg m-2] ! Local variables integer :: i, j, k From c166358b21a5edb970571b31202c7185990913ea Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Tue, 1 Feb 2022 09:58:15 -0500 Subject: [PATCH 57/73] Add optional argument to FMS2 version of get_field_size - default behavior returns field size using fms1 format. --- config_src/infra/FMS2/MOM_io_infra.F90 | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index 62a43ab99b..f8999fa7b8 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -598,7 +598,7 @@ function field_exists(filename, field_name, domain, no_domain, MOM_domain) end function field_exists !> Given filename and fieldname, this subroutine returns the size of the field in the file -subroutine get_field_size(filename, fieldname, sizes, field_found, no_domain) +subroutine get_field_size(filename, fieldname, sizes, field_found, no_domain, fms1_format) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The name of the variable whose sizes are returned integer, dimension(:), intent(inout) :: sizes !< The sizes of the variable in each dimension @@ -607,16 +607,21 @@ subroutine get_field_size(filename, fieldname, sizes, field_found, no_domain) !! is a fatal error if the field is not found. logical, optional, intent(in) :: no_domain !< If present and true, do not check for file !! names with an appended tile number - + logical, optional, intent(in) :: fms1_format !< If true (default) , then for (Nx,Ny,Nt) data + !! return sizes=(Nx,Ny,1,Nt) if sizes if 4-dimensional ! Local variables type(FmsNetcdfFile_t) :: fileobj_read ! A handle to a non-domain-decomposed file for obtaining information ! about the exiting time axis entries in append mode. logical :: success ! If true, the file was opened successfully logical :: field_exists ! True if filename exists and field_name is in filename + logical :: fms1_fmt integer :: i, ndims + if (FMS2_reads) then field_exists = .false. + fms1_fmt=.true. + if (present(fms1_format)) fms1_fmt=fms1_format if (file_exists(filename)) then success = fms2_open_file(fileObj_read, trim(filename), "read") if (success) then @@ -627,6 +632,12 @@ subroutine get_field_size(filename, fieldname, sizes, field_found, no_domain) "get_field_size called with too few sizes for "//trim(fieldname)//" in "//trim(filename)) call get_variable_size(fileobj_read, fieldname, sizes(1:ndims)) do i=ndims+1,size(sizes) ; sizes(i) = 0 ; enddo + ! This preserves previous behavior when reading time-varying data without + ! a vertical extent. + if (fms1_fmt .and. size(sizes)==ndims+1) then + sizes(ndims+1)=sizes(ndims) + sizes(ndims)=1 + endif endif endif endif From e8416091589b98ae790c9c3a63e5c7980cc56c73 Mon Sep 17 00:00:00 2001 From: Matthew Harrison Date: Wed, 2 Feb 2022 17:10:12 -0500 Subject: [PATCH 58/73] remove unnecessary optional flag --- config_src/infra/FMS2/MOM_io_infra.F90 | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index f8999fa7b8..16b7e45bc6 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -598,7 +598,7 @@ function field_exists(filename, field_name, domain, no_domain, MOM_domain) end function field_exists !> Given filename and fieldname, this subroutine returns the size of the field in the file -subroutine get_field_size(filename, fieldname, sizes, field_found, no_domain, fms1_format) +subroutine get_field_size(filename, fieldname, sizes, field_found, no_domain) character(len=*), intent(in) :: filename !< The name of the file to read character(len=*), intent(in) :: fieldname !< The name of the variable whose sizes are returned integer, dimension(:), intent(inout) :: sizes !< The sizes of the variable in each dimension @@ -607,21 +607,16 @@ subroutine get_field_size(filename, fieldname, sizes, field_found, no_domain, fm !! is a fatal error if the field is not found. logical, optional, intent(in) :: no_domain !< If present and true, do not check for file !! names with an appended tile number - logical, optional, intent(in) :: fms1_format !< If true (default) , then for (Nx,Ny,Nt) data - !! return sizes=(Nx,Ny,1,Nt) if sizes if 4-dimensional ! Local variables type(FmsNetcdfFile_t) :: fileobj_read ! A handle to a non-domain-decomposed file for obtaining information ! about the exiting time axis entries in append mode. logical :: success ! If true, the file was opened successfully logical :: field_exists ! True if filename exists and field_name is in filename - logical :: fms1_fmt integer :: i, ndims if (FMS2_reads) then field_exists = .false. - fms1_fmt=.true. - if (present(fms1_format)) fms1_fmt=fms1_format if (file_exists(filename)) then success = fms2_open_file(fileObj_read, trim(filename), "read") if (success) then @@ -634,7 +629,7 @@ subroutine get_field_size(filename, fieldname, sizes, field_found, no_domain, fm do i=ndims+1,size(sizes) ; sizes(i) = 0 ; enddo ! This preserves previous behavior when reading time-varying data without ! a vertical extent. - if (fms1_fmt .and. size(sizes)==ndims+1) then + if (size(sizes)==ndims+1) then sizes(ndims+1)=sizes(ndims) sizes(ndims)=1 endif From 32e1ecf45f8d5064b3f7e986b1e9af226958a919 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Sun, 20 Feb 2022 08:21:17 -0700 Subject: [PATCH 59/73] Fixes issues with the GME code and get_param calls for Leith options (#65) * Eliminate GET_ALL_PARAMS in hor_visc_init Added do_not_log arguments to get_param calls in MOM_hor_visc.F90 that are only used conditionally, and eliminated the unlogged GET_ALL_PARAMS runtime parameter and get_all variable in hor_visc_init(). By design, all logging of parameters after this commit is identical to before, even for variables that are inactive and therefore should not be logged. In several places, there were some problems, mostly with the GME code, that have been noted in comments marked with '###'. Also cleaned up the code alignment and eliminated unneeded temporary variables in a few places in hor_visc(). All solutions are bitwise identical, and no output is changed. * Move call to get get_KH outside k-loop The call to get the 3-d GME diffusivity arrays and the subsequent blocking halo update was moved outside of the k-loop. * Increase loop range for calculation of GME fluxes * Makes GME filter rotationally invariant * Makes the GME filter rotationally invariant * Adds a runtime param to allow the user to control how many smoothing passes should be done. * Rearranges the get_param calls related to Leith The get_param calls for Leith were not in the correct location. This commit fixes that. * Adding halo updates * Fixes do loops indices and adds diagnostics * Adds option to save barotropic tension and strain; * Fixes many i and j loops indices associated with GME to avoid halo problems and unnecessary halo updates. With these changes, the model is now conserving mass and tracers when USE_GME = True. * Fixes issues related to the merging with dev/gfdl * Fixes calculation of FrictWork_GME The calculation now mimics the calculation of FrictWork and it includes the energy diffusion term. * Removes dependency of FrictWork_GME calculation on MEKE * Adding sh_xy_sq and sh_xx_sq in the OMP directives Co-authored-by: Robert Hallberg --- .../lateral/MOM_hor_visc.F90 | 254 ++++++++++-------- 1 file changed, 145 insertions(+), 109 deletions(-) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 0249f79c2d..78f48975e5 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -2,14 +2,14 @@ module MOM_hor_visc ! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_checksums, only : hchksum, Bchksum +use MOM_checksums, only : hchksum, Bchksum, uvchksum use MOM_coms, only : min_across_PEs use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : post_product_u, post_product_sum_u use MOM_diag_mediator, only : post_product_v, post_product_sum_v use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_domains, only : pass_var, CORNER, pass_vector, AGRID, BGRID_NE +use MOM_domains, only : To_All, Scalar_Pair use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type @@ -185,6 +185,7 @@ module MOM_hor_visc ! 3D diagnostics hf_diffu(diffv) are commented because there is no clarity on proper remapping grid option. ! The code is retained for degugging purposes in the future. + integer :: num_smooth_gme !< number of smoothing passes for the GME fluxes. !>@{ !! Diagnostic id integer :: id_grid_Re_Ah = -1, id_grid_Re_Kh = -1 @@ -197,6 +198,8 @@ module MOM_hor_visc integer :: id_Ah_h = -1, id_Ah_q = -1 integer :: id_Kh_h = -1, id_Kh_q = -1 integer :: id_GME_coeff_h = -1, id_GME_coeff_q = -1 + integer :: id_dudx_bt = -1, id_dvdy_bt = -1 + integer :: id_dudy_bt = -1, id_dvdx_bt = -1 integer :: id_vort_xy_q = -1, id_div_xx_h = -1 integer :: id_sh_xy_q = -1, id_sh_xx_h = -1 integer :: id_FrictWork = -1, id_FrictWorkIntz = -1 @@ -452,12 +455,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, (CS%bound_Kh .and. .not.CS%better_bound_Kh) if (CS%use_GME) then + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 boundary_mask_h(i,j) = (G%mask2dCu(I,j) * G%mask2dCv(i,J) * G%mask2dCu(I-1,j) * G%mask2dCv(i,J-1)) enddo ; enddo - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - boundary_mask_q(I,J) = (G%mask2dCv(i,J) * G%mask2dCv(i+1,J) * G%mask2dCu(I,j) * G%mask2dCu(I,j-1)) + do J=Jsq-2,Jeq+1 ; do I=Isq-2,Ieq+1 + boundary_mask_q(I,J) = (G%mask2dCv(i,J) * G%mask2dCv(i+1,J) * G%mask2dCu(I,j) * G%mask2dCu(I,j+1)) enddo ; enddo ! initialize diag. array with zeros @@ -468,81 +472,92 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, ! Get barotropic velocities and their gradients call barotropic_get_tav(BT, ubtav, vbtav, G, US) + call pass_vector(ubtav, vbtav, G%Domain) - do j=js-1,je+2 ; do i=is-1,ie+2 + ! Calculate the barotropic horizontal tension + do j=Jsq-2,Jeq+2 ; do i=Isq-2,Ieq+2 dudx_bt(i,j) = CS%DY_dxT(i,j)*(G%IdyCu(I,j) * ubtav(I,j) - & G%IdyCu(I-1,j) * ubtav(I-1,j)) dvdy_bt(i,j) = CS%DX_dyT(i,j)*(G%IdxCv(i,J) * vbtav(i,J) - & G%IdxCv(i,J-1) * vbtav(i,J-1)) - enddo ; enddo - - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 sh_xx_bt(i,j) = dudx_bt(i,j) - dvdy_bt(i,j) enddo ; enddo ! Components for the barotropic shearing strain - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 dvdx_bt(I,J) = CS%DY_dxBu(I,J)*(vbtav(i+1,J)*G%IdyCv(i+1,J) & - vbtav(i,J)*G%IdyCv(i,J)) dudy_bt(I,J) = CS%DX_dyBu(I,J)*(ubtav(I,j+1)*G%IdxCu(I,j+1) & - ubtav(I,j)*G%IdxCu(I,j)) enddo ; enddo - call pass_vector(dudx_bt, dvdy_bt, G%Domain, stagger=BGRID_NE) - call pass_vector(dvdx_bt, dudy_bt, G%Domain, stagger=AGRID) + ! post barotropic tension and strain + if (CS%id_dudx_bt > 0) call post_data(CS%id_dudx_bt, dudx_bt, CS%diag) + if (CS%id_dvdy_bt > 0) call post_data(CS%id_dvdy_bt, dvdy_bt, CS%diag) + if (CS%id_dudy_bt > 0) call post_data(CS%id_dudy_bt, dudy_bt, CS%diag) + if (CS%id_dvdx_bt > 0) call post_data(CS%id_dvdx_bt, dvdx_bt, CS%diag) if (CS%no_slip) then - do J=js-1,Jeq ; do I=is-1,Ieq + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 sh_xy_bt(I,J) = (2.0-G%mask2dBu(I,J)) * ( dvdx_bt(I,J) + dudy_bt(I,J) ) enddo ; enddo else - do J=js-1,Jeq ; do I=is-1,Ieq + do J=Jsq-2,Jeq+2 ; do I=Isq-2,Ieq+2 sh_xy_bt(I,J) = G%mask2dBu(I,J) * ( dvdx_bt(I,J) + dudy_bt(I,J) ) enddo ; enddo endif do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 - grad_vel_mag_bt_h(i,j) = boundary_mask_h(i,j) * (dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & + grad_vel_mag_bt_h(i,j) = G%mask2dT(I,J) * boundary_mask_h(i,j) * (dudx_bt(i,j)**2 + dvdy_bt(i,j)**2 + & (0.25*((dvdx_bt(I,J)+dvdx_bt(I-1,J-1))+(dvdx_bt(I,J-1)+dvdx_bt(I-1,J))))**2 + & (0.25*((dudy_bt(I,J)+dudy_bt(I-1,J-1))+(dudy_bt(I,J-1)+dudy_bt(I-1,J))))**2) enddo ; enddo - do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 - grad_vel_mag_bt_q(I,J) = boundary_mask_q(I,J) * (dvdx_bt(I,J)**2 + dudy_bt(I,J)**2 + & + do J=Jsq-2,Jeq+1 ; do I=Isq-2,Ieq+1 + grad_vel_mag_bt_q(I,J) = G%mask2dBu(I,J) * boundary_mask_q(I,J) * (dvdx_bt(I,J)**2 + dudy_bt(I,J)**2 + & (0.25*((dudx_bt(i,j)+dudx_bt(i+1,j+1))+(dudx_bt(i,j+1)+dudx_bt(i+1,j))))**2 + & (0.25*((dvdy_bt(i,j)+dvdy_bt(i+1,j+1))+(dvdy_bt(i,j+1)+dvdy_bt(i+1,j))))**2) enddo ; enddo - do j=js-1,je+1 ; do i=is-1,ie+1 + call pass_var(h, G%domain, halo=2) + + do j=js-2,je+2 ; do i=is-2,ie+2 htot(i,j) = 0.0 enddo ; enddo - do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do j=js-2,je+2 ; do i=is-2,ie+2 htot(i,j) = htot(i,j) + GV%H_to_Z*h(i,j,k) enddo ; enddo ; enddo I_GME_h0 = 1.0 / CS%GME_h0 - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 if (grad_vel_mag_bt_h(i,j)>0) then - GME_effic_h(i,j) = CS%GME_efficiency * boundary_mask_h(i,j) * & + GME_effic_h(i,j) = CS%GME_efficiency * G%mask2dT(I,J) * & (MIN(htot(i,j) * I_GME_h0, 1.0)**2) else GME_effic_h(i,j) = 0.0 endif enddo ; enddo - do J=js-1,Jeq ; do I=is-1,Ieq + do J=Jsq-2,Jeq+1 ; do I=Isq-2,Ieq+1 if (grad_vel_mag_bt_q(I,J)>0) then h_arith_q = 0.25 * ((htot(i,j) + htot(i+1,j+1)) + (htot(i+1,j) + htot(i,j+1))) I_hq = 1.0 / h_arith_q h_harm_q = 0.25 * h_arith_q * ((htot(i,j)*I_hq + htot(i+1,j+1)*I_hq) + & (htot(i+1,j)*I_hq + htot(i,j+1)*I_hq)) - GME_effic_q(I,J) = CS%GME_efficiency * boundary_mask_q(I,J) * (MIN(h_harm_q * I_GME_h0, 1.0)**2) + GME_effic_q(I,J) = CS%GME_efficiency * G%mask2dBu(I,J) * (MIN(h_harm_q * I_GME_h0, 1.0)**2) else GME_effic_q(I,J) = 0.0 endif enddo ; enddo + call thickness_diffuse_get_KH(TD, KH_u_GME, KH_v_GME, G, GV) + + call pass_vector(KH_u_GME, KH_v_GME, G%domain, To_All+Scalar_Pair) + + if (CS%debug) & + call uvchksum("GME KH[u,v]_GME", KH_u_GME, KH_v_GME, G%HI, haloshift=2, scale=US%L_to_m**2*US%s_to_T) + endif ! use_GME !$OMP parallel do default(none) & @@ -555,7 +570,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP h_neglect, h_neglect3, FWfrac, inv_PI3, inv_PI6, H0_GME, & !$OMP diffu, diffv, Kh_h, Kh_q, Ah_h, Ah_q, FrictWork, FrictWork_GME, & !$OMP div_xx_h, sh_xx_h, vort_xy_q, sh_xy_q, GME_coeff_h, GME_coeff_q, & - !$OMP TD, KH_u_GME, KH_v_GME, grid_Re_Kh, grid_Re_Ah, NoSt, ShSt & + !$OMP KH_u_GME, KH_v_GME, grid_Re_Kh, grid_Re_Ah, NoSt, ShSt & !$OMP ) & !$OMP private( & !$OMP i, j, k, n, & @@ -565,10 +580,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, !$OMP vort_xy, vort_xy_dx, vort_xy_dy, div_xx, div_xx_dx, div_xx_dy, & !$OMP grad_div_mag_h, grad_div_mag_q, grad_vort_mag_h, grad_vort_mag_q, & !$OMP grad_vort, grad_vort_qg, grad_vort_mag_h_2d, grad_vort_mag_q_2d, & - !$OMP grad_vel_mag_h, grad_vel_mag_q, & + !$OMP grad_vel_mag_h, grad_vel_mag_q, sh_xx_sq, sh_xy_sq, & !$OMP grad_vel_mag_bt_h, grad_vel_mag_bt_q, grad_d2vel_mag_h, & !$OMP meke_res_fn, Shear_mag, Shear_mag_bc, vert_vort_mag, h_min, hrat_min, visc_bound_rem, & - !$OMP sh_xx_sq, sh_xy_sq, grid_Ah, grid_Kh, d_Del2u, d_Del2v, d_str, & + !$OMP grid_Ah, grid_Kh, d_Del2u, d_Del2v, d_str, & !$OMP Kh, Ah, AhSm, AhLth, local_strain, Sh_F_pow, & !$OMP dDel2vdx, dDel2udy, DY_dxCv, DX_dyCu, Del2vort_q, Del2vort_h, KE, & !$OMP h2uq, h2vq, hu, hv, hq, FatH, RoScl, GME_coeff & @@ -1426,52 +1441,40 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if (CS%use_GME) then - !### This call to get the 3-d GME diffusivity arrays and the subsequent blocking halo update - ! should occur outside of the k-loop, and perhaps the halo update should occur outside of - ! this routine altogether! - call thickness_diffuse_get_KH(TD, KH_u_GME, KH_v_GME, G, GV) - call pass_vector(KH_u_GME, KH_v_GME, G%Domain) - - do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + do j=Jsq-1,Jeq+2 ; do i=Isq-1,Ieq+2 GME_coeff = GME_effic_h(i,j) * 0.25 * & ((KH_u_GME(I,j,k)+KH_u_GME(I-1,j,k)) + (KH_v_GME(i,J,k)+KH_v_GME(i,J-1,k))) GME_coeff = MIN(GME_coeff, CS%GME_limiter) if ((CS%id_GME_coeff_h>0) .or. find_FrictWork) GME_coeff_h(i,j,k) = GME_coeff str_xx_GME(i,j) = GME_coeff * sh_xx_bt(i,j) - enddo ; enddo - do J=js-1,Jeq ; do I=is-1,Ieq + do J=Jsq-2,Jeq+1 ; do I=Isq-2,Ieq+1 GME_coeff = GME_effic_q(I,J) * 0.25 * & ((KH_u_GME(I,j,k)+KH_u_GME(I,j+1,k)) + (KH_v_GME(i,J,k)+KH_v_GME(i+1,J,k))) GME_coeff = MIN(GME_coeff, CS%GME_limiter) if (CS%id_GME_coeff_q>0) GME_coeff_q(I,J,k) = GME_coeff str_xy_GME(I,J) = GME_coeff * sh_xy_bt(I,J) - enddo ; enddo ! Applying GME diagonal term. This is linear and the arguments can be rescaled. - call smooth_GME(G, GME_flux_h=str_xx_GME) - call smooth_GME(G, GME_flux_q=str_xy_GME) + call smooth_GME(CS, G, GME_flux_h=str_xx_GME) + call smooth_GME(CS, G, GME_flux_q=str_xy_GME) do J=Jsq,Jeq+1 ; do i=Isq,Ieq+1 str_xx(i,j) = (str_xx(i,j) + str_xx_GME(i,j)) * (h(i,j,k) * CS%reduction_xx(i,j)) enddo ; enddo - do J=js-1,Jeq ; do I=is-1,Ieq - ! GME is applied below - if (CS%no_slip) then + ! GME is applied below + if (CS%no_slip) then + do J=js-1,Jeq ; do I=is-1,Ieq str_xy(I,J) = (str_xy(I,J) + str_xy_GME(I,J)) * (hq(I,J) * CS%reduction_xy(I,J)) - else + enddo ; enddo + else + do J=js-1,Jeq ; do I=is-1,Ieq str_xy(I,J) = (str_xy(I,J) + str_xy_GME(I,J)) * (hq(I,J) * G%mask2dBu(I,J) * CS%reduction_xy(I,J)) - endif - enddo ; enddo - - if (allocated(MEKE%GME_snk)) then - do j=js,je ; do i=is,ie - FrictWork_GME(i,j,k) = GME_coeff_h(i,j,k) * h(i,j,k) * GV%H_to_kg_m2 * grad_vel_mag_bt_h(i,j) enddo ; enddo endif @@ -1555,6 +1558,27 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, +(v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1) )) ) ) enddo ; enddo ; endif + if (CS%use_GME) then + do j=js,je ; do i=is,ie + ! Diagnose str_xx_GME*d_x u - str_yy_GME*d_y v + str_xy_GME*(d_y u + d_x v) + ! This is the old formulation that includes energy diffusion + FrictWork_GME(i,j,k) = GV%H_to_RZ * ( & + (str_xx_GME(i,j)*(u(I,j,k)-u(I-1,j,k))*G%IdxT(i,j) & + -str_xx_GME(i,j)*(v(i,J,k)-v(i,J-1,k))*G%IdyT(i,j)) & + +0.25*((str_xy_GME(I,J)*( & + (u(I,j+1,k)-u(I,j,k))*G%IdyBu(I,J) & + +(v(i+1,J,k)-v(i,J,k))*G%IdxBu(I,J) ) & + +str_xy_GME(I-1,J-1)*( & + (u(I-1,j,k)-u(I-1,j-1,k))*G%IdyBu(I-1,J-1) & + +(v(i,J-1,k)-v(i-1,J-1,k))*G%IdxBu(I-1,J-1) )) & + +(str_xy_GME(I-1,J)*( & + (u(I-1,j+1,k)-u(I-1,j,k))*G%IdyBu(I-1,J) & + +(v(i,J,k)-v(i-1,J,k))*G%IdxBu(I-1,J) ) & + +str_xy_GME(I,J-1)*( & + (u(I,j,k)-u(I,j-1,k))*G%IdyBu(I,J-1) & + +(v(i+1,J-1,k)-v(i,J-1,k))*G%IdxBu(I,J-1) )) ) ) + enddo ; enddo ; endif + ! Make a similar calculation as for FrictWork above but accumulating into ! the vertically integrated MEKE source term, and adjusting for any ! energy loss seen as a reduction in the (biharmonic) frictional source term. @@ -1818,11 +1842,10 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) "If true, use a Leith nonlinear eddy viscosity.", & default=.false., do_not_log=.not.CS%Laplacian) if (.not.CS%Laplacian) CS%Leith_Kh = .false. - ! This call duplicates one that occurs 26 lines later, and is probably unneccessary. - call get_param(param_file, mdl, "MODIFIED_LEITH", CS%Modified_Leith, & - "If true, add a term to Leith viscosity which is "//& - "proportional to the gradient of divergence.", & - default=.false., do_not_log=.not.CS%Laplacian) !### (.not.CS%Leith_Kh)? + call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & + "The nondimensional Laplacian Leith constant, "//& + "often set to 1.0", units="nondim", default=0.0, & + fail_if_missing=CS%Leith_Kh, do_not_log=.not.CS%Leith_Kh) call get_param(param_file, mdl, "USE_MEKE", use_MEKE, & default=.false., do_not_log=.true.) call get_param(param_file, mdl, "RES_SCALE_MEKE_VISC", CS%res_scale_MEKE, & @@ -1831,27 +1854,6 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) do_not_log=.not.(CS%Laplacian.and.use_MEKE)) if (.not.(CS%Laplacian.and.use_MEKE)) CS%res_scale_MEKE = .false. - call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & - "The nondimensional Laplacian Leith constant, "//& - "often set to 1.0", units="nondim", default=0.0, & - fail_if_missing=CS%Leith_Kh, do_not_log=.not.CS%Leith_Kh) - call get_param(param_file, mdl, "USE_QG_LEITH_VISC", CS%use_QG_Leith_visc, & - "If true, use QG Leith nonlinear eddy viscosity.", & - default=.false., do_not_log=.not.CS%Leith_Kh) - if (CS%use_QG_Leith_visc .and. .not. CS%Leith_Kh) call MOM_error(FATAL, & - "MOM_hor_visc.F90, hor_visc_init:"//& - "LEITH_KH must be True when USE_QG_LEITH_VISC=True.") - - !### The following two get_param_calls need to occur after Leith_Ah is read, but for now it replicates prior code. - CS%Leith_Ah = .false. - call get_param(param_file, mdl, "USE_BETA_IN_LEITH", CS%use_beta_in_Leith, & - "If true, include the beta term in the Leith nonlinear eddy viscosity.", & - default=CS%Leith_Kh, do_not_log=.not.(CS%Leith_Kh .or. CS%Leith_Ah) ) - call get_param(param_file, mdl, "MODIFIED_LEITH", CS%modified_Leith, & - "If true, add a term to Leith viscosity which is "//& - "proportional to the gradient of divergence.", & - default=.false., do_not_log=.not.(CS%Leith_Kh .or. CS%Leith_Ah) ) - call get_param(param_file, mdl, "BOUND_KH", CS%bound_Kh, & "If true, the Laplacian coefficient is locally limited "//& "to be stable.", default=.true., do_not_log=.not.CS%Laplacian) @@ -1944,6 +1946,21 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) "typically 0.015 - 0.06.", units="nondim", default=0.0, & fail_if_missing=CS%Smagorinsky_Ah, do_not_log=.not.CS%Smagorinsky_Ah) + call get_param(param_file, mdl, "USE_BETA_IN_LEITH", CS%use_beta_in_Leith, & + "If true, include the beta term in the Leith nonlinear eddy viscosity.", & + default=CS%Leith_Kh, do_not_log=.not.(CS%Leith_Kh .or. CS%Leith_Ah) ) + call get_param(param_file, mdl, "MODIFIED_LEITH", CS%modified_Leith, & + "If true, add a term to Leith viscosity which is "//& + "proportional to the gradient of divergence.", & + default=.false., do_not_log=.not.(CS%Leith_Kh .or. CS%Leith_Ah) ) + call get_param(param_file, mdl, "USE_QG_LEITH_VISC", CS%use_QG_Leith_visc, & + "If true, use QG Leith nonlinear eddy viscosity.", & + default=.false., do_not_log=.not.(CS%Leith_Kh .or. CS%Leith_Ah) ) + if (CS%use_QG_Leith_visc .and. .not. (CS%Leith_Kh .or. CS%Leith_Ah) ) then + call MOM_error(FATAL, "MOM_hor_visc.F90, hor_visc_init:"//& + "LEITH_KH or LEITH_AH must be True when USE_QG_LEITH_VISC=True.") + endif + call get_param(param_file, mdl, "BOUND_CORIOLIS", bound_Cor_def, default=.false.) call get_param(param_file, mdl, "BOUND_CORIOLIS_BIHARM", CS%bound_Coriolis, & "If true use a viscosity that increases with the square "//& @@ -1999,17 +2016,22 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) "Use the split time stepping if true.", default=.true., do_not_log=.true.) if (CS%use_GME .and. .not.split) call MOM_error(FATAL,"ERROR: Currently, USE_GME = True "// & "cannot be used with SPLIT=False.") - call get_param(param_file, mdl, "GME_H0", CS%GME_h0, & - "The strength of GME tapers quadratically to zero when the bathymetric "//& - "depth is shallower than GME_H0.", & - units="m", scale=US%m_to_Z, default=1000.0, do_not_log=.not.CS%use_GME) - call get_param(param_file, mdl, "GME_EFFICIENCY", CS%GME_efficiency, & - "The nondimensional prefactor multiplying the GME coefficient.", & - units="nondim", default=1.0, do_not_log=.not.CS%use_GME) - call get_param(param_file, mdl, "GME_LIMITER", CS%GME_limiter, & - "The absolute maximum value the GME coefficient is allowed to take.", & - units="m2 s-1", scale=US%m_to_L**2*US%T_to_s, default=1.0e7, & - do_not_log=.not.CS%use_GME) + + if (CS%use_GME) then + call get_param(param_file, mdl, "GME_NUM_SMOOTHINGS", CS%num_smooth_gme, & + "Number of smoothing passes for the GME fluxes.", & + units="nondim", default=1) + call get_param(param_file, mdl, "GME_H0", CS%GME_h0, & + "The strength of GME tapers quadratically to zero when the bathymetric "//& + "depth is shallower than GME_H0.", & + units="m", scale=US%m_to_Z, default=1000.0) + call get_param(param_file, mdl, "GME_EFFICIENCY", CS%GME_efficiency, & + "The nondimensional prefactor multiplying the GME coefficient.", & + units="nondim", default=1.0) + call get_param(param_file, mdl, "GME_LIMITER", CS%GME_limiter, & + "The absolute maximum value the GME coefficient is allowed to take.", & + units="m2 s-1", scale=US%m_to_L**2*US%T_to_s, default=1.0e7) + endif if (CS%Laplacian .or. CS%biharmonic) then call get_param(param_file, mdl, "DT", dt, & @@ -2492,6 +2514,18 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) CS%min_grid_Kh = spacing(1.) * min_grid_sp_h2 * Idt endif if (CS%use_GME) then + CS%id_dudx_bt = register_diag_field('ocean_model', 'dudx_bt', diag%axesT1, Time, & + 'Zonal component of the barotropic shearing strain at h points', 's-1', & + conversion=US%s_to_T) + CS%id_dudy_bt = register_diag_field('ocean_model', 'dudy_bt', diag%axesB1, Time, & + 'Zonal component of the barotropic shearing strain at q points', 's-1', & + conversion=US%s_to_T) + CS%id_dvdy_bt = register_diag_field('ocean_model', 'dvdy_bt', diag%axesT1, Time, & + 'Meridional component of the barotropic shearing strain at h points', 's-1', & + conversion=US%s_to_T) + CS%id_dvdx_bt = register_diag_field('ocean_model', 'dvdx_bt', diag%axesB1, Time, & + 'Meridional component of the barotropic shearing strain at q points', 's-1', & + conversion=US%s_to_T) CS%id_GME_coeff_h = register_diag_field('ocean_model', 'GME_coeff_h', diag%axesTL, Time, & 'GME coefficient at h Points', 'm2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_GME_coeff_q = register_diag_field('ocean_model', 'GME_coeff_q', diag%axesBL, Time, & @@ -2501,7 +2535,8 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) 'W m-2', conversion=US%RZ3_T3_to_W_m2*US%L_to_Z**2) endif CS%id_FrictWork = register_diag_field('ocean_model','FrictWork',diag%axesTL,Time,& - 'Integral work done by lateral friction terms', & + 'Integral work done by lateral friction terms. If GME is turned on, this '//& + 'includes the GME contribution.', & 'W m-2', conversion=US%RZ3_T3_to_W_m2*US%L_to_Z**2) CS%id_FrictWorkIntz = register_diag_field('ocean_model','FrictWorkIntz',diag%axesT1,Time, & 'Depth integrated work done by lateral friction', & @@ -2531,7 +2566,8 @@ end subroutine align_aniso_tensor_to_grid !> Apply a 1-1-4-1-1 Laplacian filter one time on GME diffusive flux to reduce any !! horizontal two-grid-point noise -subroutine smooth_GME(G, GME_flux_h, GME_flux_q) +subroutine smooth_GME(CS, G, GME_flux_h, GME_flux_q) + type(hor_visc_CS), intent(in) :: CS !< Control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: GME_flux_h!< GME diffusive flux !! at h points @@ -2542,15 +2578,18 @@ subroutine smooth_GME(G, GME_flux_h, GME_flux_q) real, dimension(SZIB_(G),SZJB_(G)) :: GME_flux_q_original real :: wc, ww, we, wn, ws ! averaging weights for smoothing integer :: i, j, k, s - do s=1,1 - ! Update halos + integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + do s=1,CS%num_smooth_gme if (present(GME_flux_h)) then - !### Work on a wider halo to eliminate this blocking send! - call pass_var(GME_flux_h, G%Domain) + ! Update halos if needed + if (s >= 2) call pass_var(GME_flux_h, G%Domain) GME_flux_h_original(:,:) = GME_flux_h(:,:) ! apply smoothing on GME - do j = G%jsc, G%jec - do i = G%isc, G%iec + do j = Jsq, Jeq+1 + do i = Isq, Ieq+1 ! skip land points if (G%mask2dT(i,j)==0.) cycle ! compute weights @@ -2558,24 +2597,22 @@ subroutine smooth_GME(G, GME_flux_h, GME_flux_q) we = 0.125 * G%mask2dT(i+1,j) ws = 0.125 * G%mask2dT(i,j-1) wn = 0.125 * G%mask2dT(i,j+1) - wc = 1.0 - (ww+we+wn+ws) - !### Add parentheses to make this rotationally invariant. + wc = 1.0 - ((ww+we)+(wn+ws)) GME_flux_h(i,j) = wc * GME_flux_h_original(i,j) & - + ww * GME_flux_h_original(i-1,j) & - + we * GME_flux_h_original(i+1,j) & - + ws * GME_flux_h_original(i,j-1) & - + wn * GME_flux_h_original(i,j+1) + + ((ww * GME_flux_h_original(i-1,j) & + + we * GME_flux_h_original(i+1,j)) & + + (ws * GME_flux_h_original(i,j-1) & + + wn * GME_flux_h_original(i,j+1))) enddo enddo endif - ! Update halos if (present(GME_flux_q)) then - !### Work on a wider halo to eliminate this blocking send! - call pass_var(GME_flux_q, G%Domain, position=CORNER, complete=.true.) + ! Update halos if needed + if (s >= 2) call pass_var(GME_flux_q, G%Domain, position=CORNER, complete=.true.) GME_flux_q_original(:,:) = GME_flux_q(:,:) ! apply smoothing on GME - do J = G%JscB, G%JecB - do I = G%IscB, G%IecB + do J = Jsq-1, Jeq + do I = Isq-1, Ieq ! skip land points if (G%mask2dBu(I,J)==0.) cycle ! compute weights @@ -2583,13 +2620,12 @@ subroutine smooth_GME(G, GME_flux_h, GME_flux_q) we = 0.125 * G%mask2dBu(I+1,J) ws = 0.125 * G%mask2dBu(I,J-1) wn = 0.125 * G%mask2dBu(I,J+1) - wc = 1.0 - (ww+we+wn+ws) - !### Add parentheses to make this rotationally invariant. + wc = 1.0 - ((ww+we)+(wn+ws)) GME_flux_q(I,J) = wc * GME_flux_q_original(I,J) & - + ww * GME_flux_q_original(I-1,J) & - + we * GME_flux_q_original(I+1,J) & - + ws * GME_flux_q_original(I,J-1) & - + wn * GME_flux_q_original(I,J+1) + + ((ww * GME_flux_q_original(I-1,J) & + + we * GME_flux_q_original(I+1,J)) & + + (ws * GME_flux_q_original(I,J-1) & + + wn * GME_flux_q_original(I,J+1))) enddo enddo endif From 149073fea0b9fa3b82880b59818710d9abbebbd5 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Sun, 20 Feb 2022 11:50:18 -0700 Subject: [PATCH 60/73] Remove hard-wired parameter in adjustEtaToFitBathymetry (#69) Subroutine adjustEtaToFitBathymetry had a hard-wired parameter (hTolerance = 0.1) controlling the tolerance when adjusting the thickness to fit the bathymetry. This patch adds an user-controlled parameter (THICKNESS_TOLERANCE), which replaces hTolerance. THICKNESS_TOLERANCE is only activated when ADJUST_THICKNESS=True. --- .../MOM_state_initialization.F90 | 32 +++++++++++++------ 1 file changed, 23 insertions(+), 9 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 22892817e6..8378644ea9 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -688,6 +688,8 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f real :: eta(SZI_(G),SZJ_(G),SZK_(GV)+1) ! Interface heights, in depth units [Z ~> m]. integer :: inconsistent = 0 logical :: correct_thickness + real :: h_tolerance ! A parameter that controls the tolerance when adjusting the + ! thickness to fit the bathymetry [Z ~> m]. character(len=40) :: mdl = "initialize_thickness_from_file" ! This subroutine's name. character(len=200) :: filename, thickness_file, inputdir, mesg ! Strings for file/path integer :: i, j, k, is, ie, js, je, nz @@ -718,12 +720,18 @@ subroutine initialize_thickness_from_file(h, depth_tot, G, GV, US, param_file, f "If true, all mass below the bottom removed if the "//& "topography is shallower than the thickness input file "//& "would indicate.", default=.false., do_not_log=just_read) + if (correct_thickness) then + call get_param(param_file, mdl, "THICKNESS_TOLERANCE", h_tolerance, & + "A parameter that controls the tolerance when adjusting the "//& + "thickness to fit the bathymetry. Used when ADJUST_THICKNESS=True.", & + units="m", default=0.1, scale=US%m_to_Z, do_not_log=just_read) + endif if (just_read) return ! All run-time parameters have been read, so return. call MOM_read_data(filename, "eta", eta(:,:,:), G%Domain, scale=US%m_to_Z) if (correct_thickness) then - call adjustEtaToFitBathymetry(G, GV, US, eta, h, dZ_ref_eta=G%Z_ref) + call adjustEtaToFitBathymetry(G, GV, US, eta, h, h_tolerance, dZ_ref_eta=G%Z_ref) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie if (eta(i,j,K) < (eta(i,j,K+1) + GV%Angstrom_Z)) then @@ -757,31 +765,29 @@ end subroutine initialize_thickness_from_file !! layers are contracted to ANGSTROM thickness (which may be 0). !! If the bottom most interface is above the topography then the entire column !! is dilated (expanded) to fill the void. -!! @remark{There is a (hard-wired) "tolerance" parameter such that the -!! criteria for adjustment must equal or exceed 10cm.} -subroutine adjustEtaToFitBathymetry(G, GV, US, eta, h, dZ_ref_eta) +subroutine adjustEtaToFitBathymetry(G, GV, US, eta, h, ht, dZ_ref_eta) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: eta !< Interface heights [Z ~> m]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, intent(in) :: ht !< Tolerance to exceed adjustment + !! criteria [Z ~> m] real, optional, intent(in) :: dZ_ref_eta !< The difference between the !! reference heights for bathyT and !! eta [Z ~> m], 0 by default. ! Local variables integer :: i, j, k, is, ie, js, je, nz, contractions, dilations - real :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria [Z ~> m] real :: dilate ! A factor by which the column is dilated [nondim] real :: dZ_ref ! The difference in the reference heights for G%bathyT and eta [Z ~> m] character(len=100) :: mesg is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - hTolerance = 0.1*US%m_to_Z dZ_ref = 0.0 ; if (present(dZ_ref_eta)) dZ_ref = dZ_ref_eta contractions = 0 do j=js,je ; do i=is,ie - if (-eta(i,j,nz+1) > (G%bathyT(i,j) + dZ_ref) + hTolerance) then + if (-eta(i,j,nz+1) > (G%bathyT(i,j) + dZ_ref) + ht) then eta(i,j,nz+1) = -(G%bathyT(i,j) + dZ_ref) contractions = contractions + 1 endif @@ -811,7 +817,7 @@ subroutine adjustEtaToFitBathymetry(G, GV, US, eta, h, dZ_ref_eta) ! The whole column is dilated to accommodate deeper topography than ! the bathymetry would indicate. ! This should be... if ((G%mask2dt(i,j)*(eta(i,j,1)-eta(i,j,nz+1)) > 0.0) .and. & - if (-eta(i,j,nz+1) < (G%bathyT(i,j) + dZ_ref) - hTolerance) then + if (-eta(i,j,nz+1) < (G%bathyT(i,j) + dZ_ref) - ht) then dilations = dilations + 1 if (eta(i,j,1) <= eta(i,j,nz+1)) then do k=1,nz ; h(i,j,k) = (eta(i,j,1) + (G%bathyT(i,j) + dZ_ref)) / real(nz) ; enddo @@ -2402,6 +2408,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just real :: dilate ! A dilation factor to match topography [nondim] real :: missing_value_temp, missing_value_salt logical :: correct_thickness + real :: h_tolerance ! A parameter that controls the tolerance when adjusting the + ! thickness to fit the bathymetry [Z ~> m]. character(len=40) :: potemp_var, salin_var character(len=8) :: laynum @@ -2535,6 +2543,12 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just "If true, all mass below the bottom removed if the "//& "topography is shallower than the thickness input file "//& "would indicate.", default=.false., do_not_log=just_read) + if (correct_thickness) then + call get_param(PF, mdl, "THICKNESS_TOLERANCE", h_tolerance, & + "A parameter that controls the tolerance when adjusting the "//& + "thickness to fit the bathymetry. Used when ADJUST_THICKNESS=True.", & + units="m", default=0.1, scale=US%m_to_Z, do_not_log=just_read) + endif call get_param(PF, mdl, "FIT_TO_TARGET_DENSITY_IC", adjust_temperature, & "If true, all the interior layers are adjusted to "//& @@ -2732,7 +2746,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just Hmix_depth, eps_z, eps_rho, density_extrap_bug) if (correct_thickness) then - call adjustEtaToFitBathymetry(G, GV, US, zi, h, dZ_ref_eta=G%Z_ref) + call adjustEtaToFitBathymetry(G, GV, US, zi, h, h_tolerance, dZ_ref_eta=G%Z_ref) else do k=nz,1,-1 ; do j=js,je ; do i=is,ie if (zi(i,j,K) < (zi(i,j,K+1) + GV%Angstrom_Z)) then From d46dbc775949f1e20572e6732fd5d15d19cadbb8 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 16 Dec 2021 07:57:23 -0500 Subject: [PATCH 61/73] Report mean temperature from MOM_state_stats() Actually calculate the mean temperature and salinity reported by MOM_state_stats(). Due to an oversight, these means were always being reported as 0. This changes the output when the debugging flag DEBUG_CONSERVATION=True. All answers are bitwise identical. --- src/core/MOM_checksum_packages.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 917a4afdc3..3951dfdc7d 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -253,8 +253,8 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, GV, US, allowChange, pe real, dimension(G%isc:G%iec, G%jsc:G%jec) :: & tmp_A, & ! The area per cell [m2] (unscaled to permit reproducing sum). tmp_V, & ! The column-integrated volume [m3] (unscaled to permit reproducing sum) - tmp_T, & ! The column-integrated temperature [degC m3] - tmp_S ! The column-integrated salinity [ppt m3] + tmp_T, & ! The column-integrated temperature [degC m3] (unscaled to permit reproducing sum) + tmp_S ! The column-integrated salinity [ppt m3] (unscaled to permit reproducing sum) real :: Vol, dV ! The total ocean volume and its change [m3] (unscaled to permit reproducing sum). real :: Area ! The total ocean surface area [m2] (unscaled to permit reproducing sum). real :: h_minimum ! The minimum layer thicknesses [H ~> m or kg m-2] @@ -294,6 +294,8 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, GV, US, allowChange, pe T%average = T%average + dV*Temp(i,j,k) S%minimum = min( S%minimum, Salt(i,j,k) ) ; S%maximum = max( S%maximum, Salt(i,j,k) ) S%average = S%average + dV*Salt(i,j,k) + tmp_T(i,j) = tmp_T(i,j) + dV*Temp(i,j,k) + tmp_S(i,j) = tmp_S(i,j) + dV*Salt(i,j,k) endif if (h_minimum > h(i,j,k)) h_minimum = h(i,j,k) endif From 9c7bf292d975c44c79a68b961509ee51eb788187 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 16 Dec 2021 07:58:01 -0500 Subject: [PATCH 62/73] +Add global_mass_int_EFP Added the new function global_mass_int_EFP(), which is analogous to global_mass_integral but returns its result in extended fixed point (EFP_type) format and always uses reproducing sums, to facilitate layout-invariant global integrals but with the potential for deferred global reductions so that this last step can be combined for various global reductions for efficiency. All answers are bitwise identical, but there is a new public interface. --- src/diagnostics/MOM_spatial_means.F90 | 45 ++++++++++++++++++++++++++- 1 file changed, 44 insertions(+), 1 deletion(-) diff --git a/src/diagnostics/MOM_spatial_means.F90 b/src/diagnostics/MOM_spatial_means.F90 index 7969ee11f8..7fc83f9b40 100644 --- a/src/diagnostics/MOM_spatial_means.F90 +++ b/src/diagnostics/MOM_spatial_means.F90 @@ -19,7 +19,7 @@ module MOM_spatial_means public :: global_i_mean, global_j_mean public :: global_area_mean, global_area_mean_u, global_area_mean_v, global_layer_mean public :: global_area_integral -public :: global_volume_mean, global_mass_integral +public :: global_volume_mean, global_mass_integral, global_mass_int_EFP public :: adjust_area_mean_to_zero contains @@ -234,6 +234,49 @@ function global_mass_integral(h, G, GV, var, on_PE_only, scale) end function global_mass_integral +!> Find the global mass-weighted order invariant integral of a variable in mks units, +!! returning the value as an EFP_type. This uses reproducing sums. +function global_mass_int_EFP(h, G, GV, var, on_PE_only, scale) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + optional, intent(in) :: var !< The variable being integrated + logical, optional, intent(in) :: on_PE_only !< If present and true, the sum is only done + !! on the local PE, but it is still order invariant. + real, optional, intent(in) :: scale !< A rescaling factor for the variable + type(EFP_type) :: global_mass_int_EFP !< The mass-weighted integral of var (or 1) in + !! kg times the units of var + + ! Local variables + real, dimension(SZI_(G), SZJ_(G)) :: tmpForSum + real :: scalefac ! An overall scaling factor for the areas and variable. + integer :: i, j, k, is, ie, js, je, nz, isr, ier, jsr, jer + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + isr = is - (G%isd-1) ; ier = ie - (G%isd-1) ; jsr = js - (G%jsd-1) ; jer = je - (G%jsd-1) + + scalefac = GV%H_to_kg_m2 * G%US%L_to_m**2 + if (present(scale)) scalefac = scale * scalefac + + tmpForSum(:,:) = 0.0 + if (present(var)) then + do k=1,nz ; do j=js,je ; do i=is,ie + tmpForSum(i,j) = tmpForSum(i,j) + var(i,j,k) * & + ((scalefac * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j))) + enddo ; enddo ; enddo + else + do k=1,nz ; do j=js,je ; do i=is,ie + tmpForSum(i,j) = tmpForSum(i,j) + & + ((scalefac * h(i,j,k)) * (G%areaT(i,j) * G%mask2dT(i,j))) + enddo ; enddo ; enddo + endif + + global_mass_int_EFP = reproducing_sum_EFP(tmpForSum, isr, ier, jsr, jer, only_on_PE=on_PE_only) + +end function global_mass_int_EFP + !> Determine the global mean of a field along rows of constant i, returning it !! in a 1-d array using the local indexing. This uses reproducing sums. From 8197cea794782e5c0cedd4d200be7a8f22358bdb Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 16 Dec 2021 08:00:51 -0500 Subject: [PATCH 63/73] Use global_mass_integral in lateral_bdry_diff Use global_mass_integral for the debugging diagnostics of the tracer amounts before and after diffusion in lateral_boundary_diffusion, and replaced a call to write(*,*) with a call to MOM_mesg to actually write the message. The global_mass_integral uses reproducing sums, and is invariant to layout, while MOM_mesg is preferable for output because it will allow us to more cleanly control how output is handled and which processors do the writing. All solutions are bitwise identical, although some debugging output will change. --- src/tracer/MOM_lateral_boundary_diffusion.F90 | 36 +++++++------------ 1 file changed, 12 insertions(+), 24 deletions(-) diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index 4a98aa1934..227e3ffb06 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -8,16 +8,17 @@ module MOM_lateral_boundary_diffusion use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE use MOM_checksums, only : hchksum -use MOM_domains, only : pass_var, sum_across_PEs +use MOM_domains, only : pass_var use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_diag_mediator, only : post_data, register_diag_field use MOM_diag_vkernels, only : reintegrate_column -use MOM_error_handler, only : MOM_error, FATAL, is_root_pe +use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_remapping, only : remapping_CS, initialize_remapping use MOM_remapping, only : extract_member_remapping_CS, remapping_core_h use MOM_remapping, only : remappingSchemesDoc, remappingDefaultScheme +use MOM_spatial_means, only : global_mass_integral use MOM_tracer_registry, only : tracer_registry_type, tracer_type use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type @@ -169,13 +170,11 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) real, dimension(SZK_(GV)) :: tracer_1d !< 1d-array used to remap tracer change to native grid real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: tracer_old !< local copy of the initial tracer concentration, !! only used to compute tendencies. - real, dimension(SZI_(G),SZJ_(G)) :: tracer_int !< integrated tracer before LBD is applied - !! [conc H L2 ~> conc m3 or conc kg] - real, dimension(SZI_(G),SZJ_(G)) :: tracer_end !< integrated tracer after LBD is applied. - !! [conc H L2 ~> conc m3 or conc kg] - integer :: i, j, k, m !< indices to loop over + real :: tracer_int_prev !< Globally integrated tracer before LBD is applied, in mks units [conc kg] + real :: tracer_int_end !< Integrated tracer after LBD is applied, in mks units [conc kg] real :: Idt !< inverse of the time step [T-1 ~> s-1] - real :: tmp1, tmp2 !< temporary variables [conc H L2 ~> conc m3 or conc kg] + character(len=256) :: mesg !< Message for error messages. + integer :: i, j, k, m !< indices to loop over call cpu_clock_begin(id_clock_lbd) Idt = 1./dt @@ -236,22 +235,11 @@ subroutine lateral_boundary_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) if (CS%debug) then call hchksum(tracer%t, "after LBD "//tracer%name,G%HI) - tracer_int(:,:) = 0.0; tracer_end(:,:) = 0.0 - ! tracer (native grid) before and after LBD - do j=G%jsc,G%jec ; do i=G%isc,G%iec - do k=1,GV%ke - tracer_int(i,j) = tracer_int(i,j) + tracer_old(i,j,k) * & - (h(i,j,k)*(G%mask2dT(i,j)*G%areaT(i,j))) - tracer_end(i,j) = tracer_end(i,j) + tracer%t(i,j,k) * & - (h(i,j,k)*(G%mask2dT(i,j)*G%areaT(i,j))) - enddo - enddo; enddo - - tmp1 = SUM(tracer_int) - tmp2 = SUM(tracer_end) - call sum_across_PEs(tmp1) - call sum_across_PEs(tmp2) - if (is_root_pe()) write(*,*)'Total '//tracer%name//' before/after LBD:', tmp1, tmp2 + ! tracer (native grid) integrated tracer amounts before and after LBD + tracer_int_prev = global_mass_integral(h, G, GV, tracer_old) + tracer_int_end = global_mass_integral(h, G, GV, tracer%t) + write(mesg,*) 'Total '//tracer%name//' before/after LBD:', tracer_int_prev, tracer_int_end + call MOM_mesg(mesg) endif ! Post the tracer diagnostics From 1bf82205a981fa0ae7390d0e513cdef8315bc23c Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 16 Dec 2021 08:04:13 -0500 Subject: [PATCH 64/73] (*)+Reproducing tracer stocks Use reproducing sums for tabulating tracer stocks, and move the global sum for the tracer stocks form write_energy into call_tracer_stocks. This involves changes to the type of an argument (from real to EFP_type) for two arguments to the internal routine store_stocks. Existing tracer stock packages will still work, but to benefit from the reproducing sums, they will also have to change their reported values from real to EFP_type. This is demonstrated for two packages (advection_test_tracer and ideal_age_example), where the stocks are now found with calls to global_mass_int_EFP(), replacing the previous explicit sums. With this change, the reported stock values from these packages are identical for different PE layouts and can be much more accurate than before, but they are different from the previously reported values at roundoff (for positive-definite tracers), but it could be larger for tracers with a near-zero mean value. All solutions are bitwise identical, but output changes. --- src/diagnostics/MOM_sum_output.F90 | 4 - src/tracer/MOM_tracer_flow_control.F90 | 100 +++++++++++++++---------- src/tracer/advection_test_tracer.F90 | 23 +++--- src/tracer/ideal_age_example.F90 | 19 ++--- 4 files changed, 77 insertions(+), 69 deletions(-) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 668c297658..a7cae98620 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -733,10 +733,6 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci enddo ; enddo ; enddo call sum_across_PEs(CS%ntrunc) - ! Sum the various quantities across all the processors. This sum is NOT - ! guaranteed to be bitwise reproducible, even on the same decomposition. - ! The sum of Tr_stocks should be reimplemented using the reproducing sums. - if (nTr_stocks > 0) call sum_across_PEs(Tr_stocks,nTr_stocks) call max_across_PEs(max_CFL, 2) diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 2ae72a3270..1941096832 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -3,21 +3,22 @@ module MOM_tracer_flow_control ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_coms, only : EFP_type, assignment(=), EFP_to_real, real_to_EFP, EFP_sum_across_PEs use MOM_diag_mediator, only : time_type, diag_ctrl use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_version, param_file_type, close_param_file -use MOM_forcing_type, only : forcing, optics_type -use MOM_get_input, only : Get_MOM_input -use MOM_grid, only : ocean_grid_type -use MOM_hor_index, only : hor_index_type +use MOM_file_parser, only : get_param, log_version, param_file_type, close_param_file +use MOM_forcing_type, only : forcing, optics_type +use MOM_get_input, only : Get_MOM_input +use MOM_grid, only : ocean_grid_type +use MOM_hor_index, only : hor_index_type use MOM_open_boundary, only : ocean_OBC_type -use MOM_restart, only : MOM_restart_CS -use MOM_sponge, only : sponge_CS -use MOM_ALE_sponge, only : ALE_sponge_CS +use MOM_restart, only : MOM_restart_CS +use MOM_sponge, only : sponge_CS +use MOM_ALE_sponge, only : ALE_sponge_CS use MOM_tracer_registry, only : tracer_registry_type -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface, thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : surface, thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type #include ! Add references to other user-provide tracer modules here. @@ -582,8 +583,8 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, US, CS, stock_names, stock type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(:), intent(out) :: stock_values !< The integrated amounts of a tracer - !! on the current PE, usually in kg x concentration [kg conc]. + real, dimension(:), intent(out) :: stock_values !< The globally mass-integrated + !! amount of a tracer [kg conc]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a !! previous call to @@ -612,7 +613,9 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, US, CS, stock_names, stock character(len=200), dimension(MAX_FIELDS_) :: names, units character(len=200) :: set_pkg_name real, dimension(MAX_FIELDS_) :: values - integer :: max_ns, ns_tot, ns, index, pkg, max_pkgs, nn + type(EFP_type), dimension(MAX_FIELDS_) :: values_EFP + type(EFP_type), dimension(MAX_FIELDS_) :: stock_val_EFP + integer :: max_ns, ns_tot, ns, index, pkg, max_pkgs, nn, n if (.not. associated(CS)) call MOM_error(FATAL, "call_tracer_stocks: "// & "Module must be initialized via call_tracer_register before it is used.") @@ -627,57 +630,66 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, US, CS, stock_names, stock if (CS%use_USER_tracer_example) then ns = USER_tracer_stock(h, values, G, GV, US, CS%USER_tracer_example_CSp, & names, units, stock_index) - call store_stocks("tracer_example", ns, names, units, values, index, stock_values, & + do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo + call store_stocks("tracer_example", ns, names, units, values_EFP, index, stock_val_EFP, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif ! if (CS%use_DOME_tracer) then ! ns = DOME_tracer_stock(h, values, G, GV, CS%DOME_tracer_CSp, & ! names, units, stock_index) -! call store_stocks("DOME_tracer", ns, names, units, values, index, stock_values, & +! do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo +! call store_stocks("DOME_tracer", ns, names, units, values_EFP, index, stock_val_EFP, & ! set_pkg_name, max_ns, ns_tot, stock_names, stock_units) ! endif if (CS%use_ideal_age) then - ns = ideal_age_stock(h, values, G, GV, US, CS%ideal_age_tracer_CSp, & + ns = ideal_age_stock(h, values_EFP, G, GV, CS%ideal_age_tracer_CSp, & names, units, stock_index) - call store_stocks("ideal_age_example", ns, names, units, values, index, & - stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) + ! do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo + call store_stocks("ideal_age_example", ns, names, units, values_EFP, index, stock_val_EFP, & + set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_regional_dyes) then ns = dye_stock(h, values, G, GV, US, CS%dye_tracer_CSp, & names, units, stock_index) - call store_stocks("regional_dyes", ns, names, units, values, index, & - stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) + do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo + call store_stocks("regional_dyes", ns, names, units, values_EFP, index, stock_val_EFP, & + set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_oil) then ns = oil_stock(h, values, G, GV, US, CS%oil_tracer_CSp, & names, units, stock_index) - call store_stocks("oil_tracer", ns, names, units, values, index, & - stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) + do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo + call store_stocks("oil_tracer", ns, names, units, values_EFP, index, stock_val_EFP, & + set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_OCMIP2_CFC) then ns = OCMIP2_CFC_stock(h, values, G, GV, US, CS%OCMIP2_CFC_CSp, names, units, stock_index) - call store_stocks("MOM_OCMIP2_CFC", ns, names, units, values, index, stock_values, & - set_pkg_name, max_ns, ns_tot, stock_names, stock_units) + do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo + call store_stocks("MOM_OCMIP2_CFC", ns, names, units, values_EFP, index, stock_val_EFP, & + set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_CFC_cap) then ns = CFC_cap_stock(h, values, G, GV, US, CS%CFC_cap_CSp, names, units, stock_index) - call store_stocks("MOM_CFC_cap", ns, names, units, values, index, stock_values, & - set_pkg_name, max_ns, ns_tot, stock_names, stock_units) + do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo + call store_stocks("MOM_CFC_cap", ns, names, units, values_EFP, index, stock_val_EFP, & + set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_advection_test_tracer) then - ns = advection_test_stock( h, values, G, GV, US, CS%advection_test_tracer_CSp, & + ns = advection_test_stock( h, values_EFP, G, GV, CS%advection_test_tracer_CSp, & names, units, stock_index ) - call store_stocks("advection_test_tracer", ns, names, units, values, index, & - stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) + ! do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo + call store_stocks("advection_test_tracer", ns, names, units, values_EFP, index, stock_val_EFP, & + set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_MOM_generic_tracer) then ns = MOM_generic_tracer_stock(h, values, G, GV, US, CS%MOM_generic_tracer_CSp, & names, units, stock_index) - call store_stocks("MOM_generic_tracer", ns, names, units, values, index, stock_values, & - set_pkg_name, max_ns, ns_tot, stock_names, stock_units) + do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo + call store_stocks("MOM_generic_tracer", ns, names, units, values_EFP, index, stock_val_EFP, & + set_pkg_name, max_ns, ns_tot, stock_names, stock_units) nn=ns_tot-ns+1 nn=MOM_generic_tracer_min_max(nn, got_min_max, global_min, global_max, & xgmin, ygmin, zgmin, xgmax, ygmax, zgmax ,& @@ -687,18 +699,26 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, US, CS, stock_names, stock if (CS%use_pseudo_salt_tracer) then ns = pseudo_salt_stock(h, values, G, GV, US, CS%pseudo_salt_tracer_CSp, & names, units, stock_index) - call store_stocks("pseudo_salt_tracer", ns, names, units, values, index, & - stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) + do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo + call store_stocks("pseudo_salt_tracer", ns, names, units, values_EFP, index, stock_val_EFP, & + set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_boundary_impulse_tracer) then ns = boundary_impulse_stock(h, values, G, GV, US, CS%boundary_impulse_tracer_CSp, & names, units, stock_index) - call store_stocks("boundary_impulse_tracer", ns, names, units, values, index, & - stock_values, set_pkg_name, max_ns, ns_tot, stock_names, stock_units) + do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo + call store_stocks("boundary_impulse_tracer", ns, names, units, values_EFP, index, stock_val_EFP, & + set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif - if (ns_tot == 0) stock_values(1) = 0.0 + ! Sum the various quantities across all the processors. + if (ns_tot > 0) then + call EFP_sum_across_PEs(stock_val_EFP, ns_tot) + do n=1,ns_tot ; stock_values(n) = EFP_to_real(stock_val_EFP(n)) ; enddo + else + stock_values(1) = 0.0 + endif if (present(num_stocks)) num_stocks = ns_tot @@ -713,11 +733,13 @@ subroutine store_stocks(pkg_name, ns, names, units, values, index, stock_values, intent(in) :: names !< Diagnostic names to use for each stock. character(len=*), dimension(:), & intent(in) :: units !< Units to use in the metadata for each stock. - real, dimension(:), intent(in) :: values !< The values of the tracer stocks + type(EFP_type), dimension(:), & + intent(in) :: values !< The values of the tracer stocks integer, intent(in) :: index !< The integer stock index from !! stocks_constants_mod of the stock to be returned. If this is !! present and greater than 0, only a single stock can be returned. - real, dimension(:), intent(inout) :: stock_values !< The master list of stock values + type(EFP_type), dimension(:), & + intent(inout) :: stock_values !< The master list of stock values character(len=*), intent(inout) :: set_pkg_name !< The name of the last tracer package whose !! stocks were stored for a specific index. This is !! used to trigger an error if there are redundant stocks. diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 8fdb525b4a..b37822823a 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -3,16 +3,18 @@ module advection_test_tracer ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_coms, only : EFP_type use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux use MOM_diag_mediator, only : diag_ctrl use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_forcing_type, only : forcing +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_io, only : slasher, vardesc, var_desc, query_vardesc use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS +use MOM_spatial_means, only : global_mass_int_EFP use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type @@ -75,8 +77,8 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ ! Local variables character(len=80) :: name, longname -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "advection_test_tracer" ! This module's name. character(len=200) :: inputdir character(len=48) :: flux_units ! The units for tracer fluxes, usually @@ -344,13 +346,12 @@ end subroutine advection_test_tracer_surface_state !> Calculate the mass-weighted integral of all tracer stocks, returning the number of stocks it has calculated. !! If the stock_index is present, only the stock corresponding to that coded index is returned. -function advection_test_stock(h, stocks, G, GV, US, CS, names, units, stock_index) +function advection_test_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each + type(EFP_type), dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(advection_test_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_advection_test_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. @@ -359,7 +360,6 @@ function advection_test_stock(h, stocks, G, GV, US, CS, names, units, stock_inde integer :: advection_test_stock !< the number of stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -374,14 +374,9 @@ function advection_test_stock(h, stocks, G, GV, US, CS, names, units, stock_inde return endif ; endif - stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="advection_test_stock") - stocks(m) = 0.0 - do k=1,nz ; do j=js,je ; do i=is,ie - stocks(m) = stocks(m) + CS%tr(i,j,k,m) * (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) - enddo ; enddo ; enddo - stocks(m) = stock_scale * stocks(m) + stocks(m) = global_mass_int_EFP(h, G, GV, CS%tr(:,:,:,m), on_PE_only=.true.) enddo advection_test_stock = CS%ntr diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index d5c813b3d0..5913251b14 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -3,6 +3,7 @@ module ideal_age_example ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_coms, only : EFP_type use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux use MOM_diag_mediator, only : diag_ctrl use MOM_error_handler, only : MOM_error, FATAL, WARNING @@ -13,6 +14,7 @@ module ideal_age_example use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS +use MOM_spatial_means, only : global_mass_int_EFP use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type, time_type_to_real use MOM_tracer_registry, only : register_tracer, tracer_registry_type @@ -78,8 +80,8 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) !! diffusion module type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "ideal_age_example" ! This module's name. character(len=200) :: inputdir ! The directory where the input files are. character(len=48) :: var_name ! The variable's name. @@ -369,14 +371,13 @@ end subroutine ideal_age_tracer_column_physics !> Calculates the mass-weighted integral of all tracer stocks, returning the number of stocks it !! has calculated. If stock_index is present, only the stock corresponding to that coded index is found. -function ideal_age_stock(h, stocks, G, GV, US, CS, names, units, stock_index) +function ideal_age_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each + type(EFP_type), dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc]. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_ideal_age_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. @@ -386,7 +387,6 @@ function ideal_age_stock(h, stocks, G, GV, US, CS, names, units, stock_index) integer :: ideal_age_stock !< The number of stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -401,15 +401,10 @@ function ideal_age_stock(h, stocks, G, GV, US, CS, names, units, stock_index) return endif ; endif - stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="ideal_age_stock") units(m) = trim(units(m))//" kg" - stocks(m) = 0.0 - do k=1,nz ; do j=js,je ; do i=is,ie - stocks(m) = stocks(m) + CS%tr(i,j,k,m) * (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) - enddo ; enddo ; enddo - stocks(m) = stock_scale * stocks(m) + stocks(m) = global_mass_int_EFP(h, G, GV, CS%tr(:,:,:,m), on_PE_only=.true.) enddo ideal_age_stock = CS%ntr From a0d02387ecce5e6ed78b9df7028c021c0949bfa3 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Mon, 21 Feb 2022 16:00:36 -0500 Subject: [PATCH 65/73] (*)+Use reproducing stocks for all tracer packages Modified the remaining tracer packages to use the reproducing stocks. The reported stock values from these packages will have changed slightly, but they now reproduce across PE layouts. All solutions are bitwise identical, but output changes. --- src/tracer/MOM_CFC_cap.F90 | 25 +++-------- src/tracer/MOM_OCMIP2_CFC.F90 | 60 +++++++++++--------------- src/tracer/MOM_generic_tracer.F90 | 22 +++------- src/tracer/MOM_tracer_flow_control.F90 | 29 ++++--------- src/tracer/boundary_impulse_tracer.F90 | 56 ++++++++++-------------- src/tracer/dye_example.F90 | 26 +++++------ src/tracer/oil_tracer.F90 | 57 +++++++++++------------- src/tracer/pseudo_salt_tracer.F90 | 18 +++----- src/tracer/tracer_example.F90 | 55 +++++++++++------------ 9 files changed, 137 insertions(+), 211 deletions(-) diff --git a/src/tracer/MOM_CFC_cap.F90 b/src/tracer/MOM_CFC_cap.F90 index 7296f1d469..c174fe4c39 100644 --- a/src/tracer/MOM_CFC_cap.F90 +++ b/src/tracer/MOM_CFC_cap.F90 @@ -4,6 +4,7 @@ module MOM_CFC_cap ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_coms, only : EFP_type use MOM_diag_mediator, only : diag_ctrl, register_diag_field, post_data use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type @@ -14,6 +15,7 @@ module MOM_CFC_cap use MOM_io, only : vardesc, var_desc, query_vardesc, stdout use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS +use MOM_spatial_means, only : global_mass_int_EFP use MOM_time_manager, only : time_type use time_interp_external_mod, only : init_external_field, time_interp_external use MOM_tracer_registry, only : register_tracer, tracer_registry_type @@ -341,14 +343,13 @@ end subroutine CFC_cap_column_physics !> Calculates the mass-weighted integral of all tracer stocks, !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function CFC_cap_stock(h, stocks, G, GV, US, CS, names, units, stock_index) +function CFC_cap_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each - !! tracer, in kg times concentration units [kg conc]. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(EFP_type), dimension(:), intent(out) :: stocks !< The mass-weighted integrated amount of each + !! tracer, in kg times concentration units [kg conc] type(CFC_cap_CS), pointer :: CS !< The control structure returned by a !! previous call to register_CFC_cap. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. @@ -357,11 +358,6 @@ function CFC_cap_stock(h, stocks, G, GV, US, CS, names, units, stock_index) !! stock being sought. integer :: CFC_cap_stock !< The number of stocks calculated here. - ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] - real :: mass ! The cell volume or mass [H L2 ~> m3 or kg] - integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke CFC_cap_stock = 0 if (.not.associated(CS)) return @@ -377,15 +373,8 @@ function CFC_cap_stock(h, stocks, G, GV, US, CS, names, units, stock_index) call query_vardesc(CS%CFC12_desc, name=names(2), units=units(2), caller="CFC_cap_stock") units(1) = trim(units(1))//" kg" ; units(2) = trim(units(2))//" kg" - stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 - stocks(1) = 0.0 ; stocks(2) = 0.0 - do k=1,nz ; do j=js,je ; do i=is,ie - mass = G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k) - stocks(1) = stocks(1) + CS%CFC11(i,j,k) * mass - stocks(2) = stocks(2) + CS%CFC12(i,j,k) * mass - enddo ; enddo ; enddo - stocks(1) = stock_scale * stocks(1) - stocks(2) = stock_scale * stocks(2) + stocks(1) = global_mass_int_EFP(h, G, GV, CS%CFC11, on_PE_only=.true.) + stocks(2) = global_mass_int_EFP(h, G, GV, CS%CFC12, on_PE_only=.true.) CFC_cap_stock = 2 diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 5fe55b896b..28a9501d51 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -3,25 +3,28 @@ module MOM_OCMIP2_CFC ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_coupler_types, only : extract_coupler_type_data, set_coupler_type_data -use MOM_coupler_types, only : atmos_ocn_coupler_flux -use MOM_diag_mediator, only : diag_ctrl -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_forcing_type, only : forcing -use MOM_hor_index, only : hor_index_type -use MOM_grid, only : ocean_grid_type -use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc -use MOM_open_boundary, only : ocean_OBC_type -use MOM_restart, only : query_initialized, MOM_restart_CS -use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type +use MOM_coms, only : EFP_type +use MOM_coupler_types, only : extract_coupler_type_data, set_coupler_type_data +use MOM_coupler_types, only : atmos_ocn_coupler_flux +use MOM_diag_mediator, only : diag_ctrl +use MOM_error_handler, only : MOM_error, FATAL, WARNING +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_forcing_type, only : forcing +use MOM_hor_index, only : hor_index_type +use MOM_grid, only : ocean_grid_type +use MOM_io, only : file_exists, MOM_read_data, slasher +use MOM_io, only : vardesc, var_desc, query_vardesc +use MOM_open_boundary, only : ocean_OBC_type +use MOM_restart, only : query_initialized, MOM_restart_CS +use MOM_spatial_means, only : global_mass_int_EFP +use MOM_sponge, only : set_up_sponge_field, sponge_CS +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut -use MOM_tracer_Z_init, only : tracer_Z_init -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface -use MOM_verticalGrid, only : verticalGrid_type +use MOM_tracer_Z_init, only : tracer_Z_init +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : surface +use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -478,14 +481,13 @@ end subroutine OCMIP2_CFC_column_physics !> This function calculates the mass-weighted integral of all tracer stocks, !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function OCMIP2_CFC_stock(h, stocks, G, GV, US, CS, names, units, stock_index) +function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each - !! tracer, in kg times concentration units [kg conc]. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(EFP_type), dimension(:), intent(out) :: stocks !< The mass-weighted integrated amount of each + !! tracer, in kg times concentration units [kg conc] type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a !! previous call to register_OCMIP2_CFC. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. @@ -494,11 +496,6 @@ function OCMIP2_CFC_stock(h, stocks, G, GV, US, CS, names, units, stock_index) !! stock being sought. integer :: OCMIP2_CFC_stock !< The number of stocks calculated here. - ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] - real :: mass ! The cell volume or mass [H L2 ~> m3 or kg] - integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke OCMIP2_CFC_stock = 0 if (.not.associated(CS)) return @@ -514,15 +511,8 @@ function OCMIP2_CFC_stock(h, stocks, G, GV, US, CS, names, units, stock_index) call query_vardesc(CS%CFC12_desc, name=names(2), units=units(2), caller="OCMIP2_CFC_stock") units(1) = trim(units(1))//" kg" ; units(2) = trim(units(2))//" kg" - stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 - stocks(1) = 0.0 ; stocks(2) = 0.0 - do k=1,nz ; do j=js,je ; do i=is,ie - mass = G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k) - stocks(1) = stocks(1) + CS%CFC11(i,j,k) * mass - stocks(2) = stocks(2) + CS%CFC12(i,j,k) * mass - enddo ; enddo ; enddo - stocks(1) = stock_scale * stocks(1) - stocks(2) = stock_scale * stocks(2) + stocks(1) = global_mass_int_EFP(h, G, GV, CS%CFC11, on_PE_only=.true.) + stocks(2) = global_mass_int_EFP(h, G, GV, CS%CFC12, on_PE_only=.true.) OCMIP2_CFC_stock = 2 diff --git a/src/tracer/MOM_generic_tracer.F90 b/src/tracer/MOM_generic_tracer.F90 index f8c0f6ac06..31acb51160 100644 --- a/src/tracer/MOM_generic_tracer.F90 +++ b/src/tracer/MOM_generic_tracer.F90 @@ -29,7 +29,7 @@ module MOM_generic_tracer use g_tracer_utils, only: g_tracer_get_pointer,g_tracer_get_alias,g_tracer_set_csdiag use MOM_ALE_sponge, only : set_up_ALE_sponge_field, ALE_sponge_CS - use MOM_coms, only : max_across_PEs, min_across_PEs, PE_here + use MOM_coms, only : EFP_type, max_across_PEs, min_across_PEs, PE_here use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, get_diag_time_end use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE, is_root_pe @@ -40,7 +40,7 @@ module MOM_generic_tracer use MOM_io, only : file_exists, MOM_read_data, slasher use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS - use MOM_spatial_means, only : global_area_mean + use MOM_spatial_means, only : global_area_mean, global_mass_int_EFP use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type, set_time use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut @@ -568,13 +568,12 @@ end subroutine MOM_generic_tracer_column_physics !! being requested specifically, returning the number of stocks it has !! calculated. If the stock_index is present, only the stock corresponding !! to that coded index is returned. - function MOM_generic_tracer_stock(h, stocks, G, GV, US, CS, names, units, stock_index) + function MOM_generic_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(:), intent(out) :: stocks !< The mass-weighted integrated amount of each - !! tracer, in kg times concentration units [kg conc]. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(EFP_type), dimension(:), intent(out) :: stocks !< The mass-weighted integrated amount of each + !! tracer, in kg times concentration units [kg conc] type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. @@ -584,14 +583,12 @@ function MOM_generic_tracer_stock(h, stocks, G, GV, US, CS, names, units, stock_ !! number of stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] type(g_tracer_type), pointer :: g_tracer, g_tracer_next real, dimension(:,:,:,:), pointer :: tr_field real, dimension(:,:,:), pointer :: tr_ptr character(len=128), parameter :: sub_name = 'MOM_generic_tracer_stock' - integer :: i, j, k, is, ie, js, je, nz, m - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + integer :: m MOM_generic_tracer_stock = 0 if (.not.associated(CS)) return @@ -605,7 +602,6 @@ function MOM_generic_tracer_stock(h, stocks, G, GV, US, CS, names, units, stock_ if (.NOT. associated(CS%g_tracer_list)) return ! No stocks. - stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 m=1 ; g_tracer=>CS%g_tracer_list do call g_tracer_get_alias(g_tracer,names(m)) @@ -613,12 +609,8 @@ function MOM_generic_tracer_stock(h, stocks, G, GV, US, CS, names, units, stock_ units(m) = trim(units(m))//" kg" call g_tracer_get_pointer(g_tracer,names(m),'field',tr_field) - stocks(m) = 0.0 tr_ptr => tr_field(:,:,:,1) - do k=1,nz ; do j=js,je ; do i=is,ie - stocks(m) = stocks(m) + tr_ptr(i,j,k) * (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) - enddo ; enddo ; enddo - stocks(m) = stock_scale * stocks(m) + stocks(m) = global_mass_int_EFP(h, G, GV, tr_ptr, on_PE_only=.true.) !traverse the linked list till hit NULL call g_tracer_get_next(g_tracer, g_tracer_next) diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 1941096832..ce747bba01 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -612,7 +612,7 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, US, CS, stock_names, stock ! Local variables character(len=200), dimension(MAX_FIELDS_) :: names, units character(len=200) :: set_pkg_name - real, dimension(MAX_FIELDS_) :: values + ! real, dimension(MAX_FIELDS_) :: values type(EFP_type), dimension(MAX_FIELDS_) :: values_EFP type(EFP_type), dimension(MAX_FIELDS_) :: stock_val_EFP integer :: max_ns, ns_tot, ns, index, pkg, max_pkgs, nn, n @@ -628,9 +628,8 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, US, CS, stock_names, stock ! Add other user-provided calls here. if (CS%use_USER_tracer_example) then - ns = USER_tracer_stock(h, values, G, GV, US, CS%USER_tracer_example_CSp, & + ns = USER_tracer_stock(h, values_EFP, G, GV, CS%USER_tracer_example_CSp, & names, units, stock_index) - do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo call store_stocks("tracer_example", ns, names, units, values_EFP, index, stock_val_EFP, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif @@ -644,34 +643,27 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, US, CS, stock_names, stock if (CS%use_ideal_age) then ns = ideal_age_stock(h, values_EFP, G, GV, CS%ideal_age_tracer_CSp, & names, units, stock_index) - ! do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo call store_stocks("ideal_age_example", ns, names, units, values_EFP, index, stock_val_EFP, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_regional_dyes) then - ns = dye_stock(h, values, G, GV, US, CS%dye_tracer_CSp, & - names, units, stock_index) - do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo + ns = dye_stock(h, values_EFP, G, GV, CS%dye_tracer_CSp, names, units, stock_index) call store_stocks("regional_dyes", ns, names, units, values_EFP, index, stock_val_EFP, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_oil) then - ns = oil_stock(h, values, G, GV, US, CS%oil_tracer_CSp, & - names, units, stock_index) - do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo + ns = oil_stock(h, values_EFP, G, GV, CS%oil_tracer_CSp, names, units, stock_index) call store_stocks("oil_tracer", ns, names, units, values_EFP, index, stock_val_EFP, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_OCMIP2_CFC) then - ns = OCMIP2_CFC_stock(h, values, G, GV, US, CS%OCMIP2_CFC_CSp, names, units, stock_index) - do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo + ns = OCMIP2_CFC_stock(h, values_EFP, G, GV, CS%OCMIP2_CFC_CSp, names, units, stock_index) call store_stocks("MOM_OCMIP2_CFC", ns, names, units, values_EFP, index, stock_val_EFP, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_CFC_cap) then - ns = CFC_cap_stock(h, values, G, GV, US, CS%CFC_cap_CSp, names, units, stock_index) - do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo + ns = CFC_cap_stock(h, values_EFP, G, GV, CS%CFC_cap_CSp, names, units, stock_index) call store_stocks("MOM_CFC_cap", ns, names, units, values_EFP, index, stock_val_EFP, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif @@ -685,9 +677,8 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, US, CS, stock_names, stock endif if (CS%use_MOM_generic_tracer) then - ns = MOM_generic_tracer_stock(h, values, G, GV, US, CS%MOM_generic_tracer_CSp, & + ns = MOM_generic_tracer_stock(h, values_EFP, G, GV, CS%MOM_generic_tracer_CSp, & names, units, stock_index) - do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo call store_stocks("MOM_generic_tracer", ns, names, units, values_EFP, index, stock_val_EFP, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) nn=ns_tot-ns+1 @@ -697,17 +688,15 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, US, CS, stock_names, stock endif if (CS%use_pseudo_salt_tracer) then - ns = pseudo_salt_stock(h, values, G, GV, US, CS%pseudo_salt_tracer_CSp, & + ns = pseudo_salt_stock(h, values_EFP, G, GV, CS%pseudo_salt_tracer_CSp, & names, units, stock_index) - do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo call store_stocks("pseudo_salt_tracer", ns, names, units, values_EFP, index, stock_val_EFP, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif if (CS%use_boundary_impulse_tracer) then - ns = boundary_impulse_stock(h, values, G, GV, US, CS%boundary_impulse_tracer_CSp, & + ns = boundary_impulse_stock(h, values_EFP, G, GV, CS%boundary_impulse_tracer_CSp, & names, units, stock_index) - do n=1,ns ; values_EFP(n) = real_to_EFP(values(n)) ; enddo call store_stocks("boundary_impulse_tracer", ns, names, units, values_EFP, index, stock_val_EFP, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) endif diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index ea60a09608..44423b5650 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -3,24 +3,26 @@ module boundary_impulse_tracer ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux -use MOM_diag_mediator, only : diag_ctrl -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_forcing_type, only : forcing -use MOM_grid, only : ocean_grid_type -use MOM_hor_index, only : hor_index_type -use MOM_io, only : vardesc, var_desc, query_vardesc -use MOM_open_boundary, only : ocean_OBC_type -use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS -use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type +use MOM_coms, only : EFP_type +use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux +use MOM_diag_mediator, only : diag_ctrl +use MOM_error_handler, only : MOM_error, FATAL, WARNING +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_forcing_type, only : forcing +use MOM_grid, only : ocean_grid_type +use MOM_hor_index, only : hor_index_type +use MOM_io, only : vardesc, var_desc, query_vardesc +use MOM_open_boundary, only : ocean_OBC_type +use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS +use MOM_spatial_means, only : global_mass_int_EFP +use MOM_sponge, only : set_up_sponge_field, sponge_CS +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut -use MOM_tracer_Z_init, only : tracer_Z_init -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface, thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type +use MOM_tracer_Z_init, only : tracer_Z_init +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : surface, thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -287,13 +289,12 @@ end subroutine boundary_impulse_tracer_column_physics !> This function calculates the mass-weighted integral of the boundary impulse, !! tracer stocks returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function boundary_impulse_stock(h, stocks, G, GV, US, CS, names, units, stock_index) +function boundary_impulse_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in ) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in ) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(:), intent( out) :: stocks !< the mass-weighted integrated amount of each - !! tracer, in kg times concentration units [kg conc]. - type(unit_scale_type), intent(in ) :: US !< A dimensional unit scaling type + type(EFP_type), dimension(:), intent( out) :: stocks !< The mass-weighted integrated amount of each + !! tracer, in kg times concentration units [kg conc] type(boundary_impulse_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_boundary_impulse_tracer. character(len=*), dimension(:), intent( out) :: names !< The names of the stocks calculated. @@ -302,14 +303,8 @@ function boundary_impulse_stock(h, stocks, G, GV, US, CS, names, units, stock_in !! being sought. integer :: boundary_impulse_stock !< Return value: the number of stocks calculated here. -! This function calculates the mass-weighted integral of all tracer stocks, -! returning the number of stocks it has calculated. If the stock_index -! is present, only the stock corresponding to that coded index is returned. - ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] - integer :: i, j, k, is, ie, js, je, nz, m - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + integer :: m boundary_impulse_stock = 0 if (.not.associated(CS)) return @@ -322,15 +317,10 @@ function boundary_impulse_stock(h, stocks, G, GV, US, CS, names, units, stock_in return endif ; endif - stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,1 call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="boundary_impulse_stock") units(m) = trim(units(m))//" kg" - stocks(m) = 0.0 - do k=1,nz ; do j=js,je ; do i=is,ie - stocks(m) = stocks(m) + CS%tr(i,j,k,m) * (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) - enddo ; enddo ; enddo - stocks(m) = stock_scale * stocks(m) + stocks(m) = global_mass_int_EFP(h, G, GV, CS%tr(:,:,:,m), on_PE_only=.true.) enddo boundary_impulse_stock = CS%ntr diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index dca01e974a..d7c7a7bad3 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -3,6 +3,7 @@ module regional_dyes ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_coms, only : EFP_type use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux use MOM_diag_mediator, only : diag_ctrl use MOM_error_handler, only : MOM_error, FATAL, WARNING @@ -13,6 +14,7 @@ module regional_dyes use MOM_io, only : vardesc, var_desc, query_vardesc use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS +use MOM_spatial_means, only : global_mass_int_EFP use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type @@ -74,13 +76,13 @@ function register_dye_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) !! structure for the tracer advection and diffusion module. type(MOM_restart_CS), target, intent(inout) :: restart_CS !< MOM restart control struct -! Local variables -! This include declares and sets the variable "version". -#include "version_variable.h" + ! Local variables character(len=40) :: mdl = "regional_dyes" ! This module's name. character(len=200) :: inputdir ! The directory where the input files are. character(len=48) :: var_name ! The variable's name. character(len=48) :: desc_name ! The variable's descriptor. + ! This include declares and sets the variable "version". +# include "version_variable.h" real, pointer :: tr_ptr(:,:,:) => NULL() logical :: register_dye_tracer integer :: isd, ied, jsd, jed, nz, m @@ -325,13 +327,12 @@ end subroutine dye_tracer_column_physics !> This function calculates the mass-weighted integral of all tracer stocks, !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function dye_stock(h, stocks, G, GV, US, CS, names, units, stock_index) +function dye_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of - !! each tracer, in kg times concentration units [kg conc]. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(EFP_type), dimension(:), intent(out) :: stocks !< The mass-weighted integrated amount of each + !! tracer, in kg times concentration units [kg conc] type(dye_tracer_CS), pointer :: CS !< The control structure returned by a !! previous call to register_dye_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. @@ -342,9 +343,7 @@ function dye_stock(h, stocks, G, GV, US, CS, names, units, stock_index) !! calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] - integer :: i, j, k, is, ie, js, je, nz, m - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + integer :: m dye_stock = 0 if (.not.associated(CS)) return @@ -357,15 +356,10 @@ function dye_stock(h, stocks, G, GV, US, CS, names, units, stock_index) return endif ; endif - stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="dye_stock") units(m) = trim(units(m))//" kg" - stocks(m) = 0.0 - do k=1,nz ; do j=js,je ; do i=is,ie - stocks(m) = stocks(m) + CS%tr(i,j,k,m) * (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) - enddo ; enddo ; enddo - stocks(m) = stock_scale * stocks(m) + stocks(m) = global_mass_int_EFP(h, G, GV, CS%tr(:,:,:,m), on_PE_only=.true.) enddo dye_stock = CS%ntr diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 6f690ab760..0c5a4e6e8d 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -3,24 +3,27 @@ module oil_tracer ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux -use MOM_diag_mediator, only : diag_ctrl -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_forcing_type, only : forcing -use MOM_grid, only : ocean_grid_type -use MOM_hor_index, only : hor_index_type -use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc -use MOM_open_boundary, only : ocean_OBC_type -use MOM_restart, only : query_initialized, MOM_restart_CS -use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type, time_type_to_real +use MOM_coms, only : EFP_type +use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux +use MOM_diag_mediator, only : diag_ctrl +use MOM_error_handler, only : MOM_error, FATAL, WARNING +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_forcing_type, only : forcing +use MOM_grid, only : ocean_grid_type +use MOM_hor_index, only : hor_index_type +use MOM_io, only : file_exists, MOM_read_data, slasher +use MOM_io, only : vardesc, var_desc, query_vardesc +use MOM_open_boundary, only : ocean_OBC_type +use MOM_restart, only : query_initialized, MOM_restart_CS +use MOM_spatial_means, only : global_mass_int_EFP +use MOM_sponge, only : set_up_sponge_field, sponge_CS +use MOM_time_manager, only : time_type, time_type_to_real use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut -use MOM_tracer_Z_init, only : tracer_Z_init -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface, thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type +use MOM_tracer_Z_init, only : tracer_Z_init +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : surface, thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -81,7 +84,7 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) ! Local variables character(len=40) :: mdl = "oil_tracer" ! This module's name. -! This include declares and sets the variable "version". + ! This include declares and sets the variable "version". # include "version_variable.h" real, dimension(NTR_MAX) :: oil_decay_days !< Decay time scale of oil [days] character(len=200) :: inputdir ! The directory where the input files are. @@ -402,13 +405,12 @@ end subroutine oil_tracer_column_physics !> Calculate the mass-weighted integral of the oil tracer stocks, returning the number of stocks it !! has calculated. If the stock_index is present, only the stock corresponding to that coded index is returned. -function oil_stock(h, stocks, G, GV, US, CS, names, units, stock_index) +function oil_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each - !! tracer, in kg times concentration units [kg conc]. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + type(EFP_type), dimension(:), intent(out) :: stocks !< The mass-weighted integrated amount of each + !! tracer, in kg times concentration units [kg conc] type(oil_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_oil_tracer. character(len=*), dimension(:), intent(out) :: names !< the names of the stocks calculated. @@ -418,9 +420,7 @@ function oil_stock(h, stocks, G, GV, US, CS, names, units, stock_index) integer :: oil_stock !< The number of stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] - integer :: i, j, k, is, ie, js, je, nz, m - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + integer :: m oil_stock = 0 if (.not.associated(CS)) return @@ -433,15 +433,10 @@ function oil_stock(h, stocks, G, GV, US, CS, names, units, stock_index) return endif ; endif - stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="oil_stock") units(m) = trim(units(m))//" kg" - stocks(m) = 0.0 - do k=1,nz ; do j=js,je ; do i=is,ie - stocks(m) = stocks(m) + CS%tr(i,j,k,m) * (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) - enddo ; enddo ; enddo - stocks(m) = stock_scale * stocks(m) + stocks(m) = global_mass_int_EFP(h, G, GV, CS%tr(:,:,:,m), on_PE_only=.true.) enddo oil_stock = CS%ntr diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index c441e519be..6c22daa150 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -3,6 +3,7 @@ module pseudo_salt_tracer ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_coms, only : EFP_type use MOM_debugging, only : hchksum use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl @@ -14,6 +15,7 @@ module pseudo_salt_tracer use MOM_io, only : vardesc, var_desc, query_vardesc use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS +use MOM_spatial_means, only : global_mass_int_EFP use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type @@ -253,13 +255,12 @@ end subroutine pseudo_salt_tracer_column_physics !> Calculates the mass-weighted integral of all tracer stocks, returning the number of stocks it has !! calculated. If the stock_index is present, only the stock corresponding to that coded index is returned. -function pseudo_salt_stock(h, stocks, G, GV, US, CS, names, units, stock_index) +function pseudo_salt_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each + type(EFP_type), dimension(:), intent(out) :: stocks !< The mass-weighted integrated amount of each !! tracer, in kg times concentration units [kg conc] - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(pseudo_salt_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_pseudo_salt_tracer character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated @@ -269,10 +270,6 @@ function pseudo_salt_stock(h, stocks, G, GV, US, CS, names, units, stock_index) integer :: pseudo_salt_stock !< Return value: the number of !! stocks calculated here - ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] - integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke pseudo_salt_stock = 0 if (.not.associated(CS)) return @@ -285,14 +282,9 @@ function pseudo_salt_stock(h, stocks, G, GV, US, CS, names, units, stock_index) return endif ; endif - stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 call query_vardesc(CS%tr_desc, name=names(1), units=units(1), caller="pseudo_salt_stock") units(1) = trim(units(1))//" kg" - stocks(1) = 0.0 - do k=1,nz ; do j=js,je ; do i=is,ie - stocks(1) = stocks(1) + CS%diff(i,j,k) * (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) - enddo ; enddo ; enddo - stocks(1) = stock_scale * stocks(1) + stocks(1) = global_mass_int_EFP(h, G, GV, CS%diff, on_PE_only=.true.) pseudo_salt_stock = 1 diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index a41f0ab76d..3848b84eff 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -3,22 +3,25 @@ module USER_tracer_example ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux -use MOM_diag_mediator, only : diag_ctrl -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_forcing_type, only : forcing -use MOM_grid, only : ocean_grid_type -use MOM_hor_index, only : hor_index_type -use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc -use MOM_open_boundary, only : ocean_OBC_type -use MOM_restart, only : MOM_restart_CS -use MOM_sponge, only : set_up_sponge_field, sponge_CS -use MOM_time_manager, only : time_type +use MOM_coms, only : EFP_type +use MOM_coupler_types, only : set_coupler_type_data, atmos_ocn_coupler_flux +use MOM_diag_mediator, only : diag_ctrl +use MOM_error_handler, only : MOM_error, FATAL, WARNING +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_forcing_type, only : forcing +use MOM_grid, only : ocean_grid_type +use MOM_hor_index, only : hor_index_type +use MOM_io, only : file_exists, MOM_read_data, slasher +use MOM_io, only : vardesc, var_desc, query_vardesc +use MOM_open_boundary, only : ocean_OBC_type +use MOM_restart, only : MOM_restart_CS +use MOM_spatial_means, only : global_mass_int_EFP +use MOM_sponge, only : set_up_sponge_field, sponge_CS +use MOM_time_manager, only : time_type use MOM_tracer_registry, only : register_tracer, tracer_registry_type -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface -use MOM_verticalGrid, only : verticalGrid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : surface +use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -64,8 +67,8 @@ function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS ! Local variables character(len=80) :: name, longname -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "tracer_example" ! This module's name. character(len=200) :: inputdir character(len=48) :: flux_units ! The units for tracer fluxes, usually @@ -358,14 +361,13 @@ end subroutine tracer_column_physics !> This function calculates the mass-weighted integral of all tracer stocks, !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. -function USER_tracer_stock(h, stocks, G, GV, US, CS, names, units, stock_index) +function USER_tracer_stock(h, stocks, G, GV, CS, names, units, stock_index) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each - !! tracer, in kg times concentration units [kg conc]. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(EFP_type), dimension(:), intent(out) :: stocks !< The mass-weighted integrated amount of each + !! tracer, in kg times concentration units [kg conc] type(USER_tracer_example_CS), pointer :: CS !< The control structure returned by a !! previous call to register_USER_tracer. character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. @@ -376,9 +378,7 @@ function USER_tracer_stock(h, stocks, G, GV, US, CS, names, units, stock_index) !! stocks calculated here. ! Local variables - real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] - integer :: i, j, k, is, ie, js, je, nz, m - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + integer :: m USER_tracer_stock = 0 if (.not.associated(CS)) return @@ -390,15 +390,10 @@ function USER_tracer_stock(h, stocks, G, GV, US, CS, names, units, stock_index) return endif ; endif - stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 do m=1,NTR call query_vardesc(CS%tr_desc(m), name=names(m), units=units(m), caller="USER_tracer_stock") units(m) = trim(units(m))//" kg" - stocks(m) = 0.0 - do k=1,nz ; do j=js,je ; do i=is,ie - stocks(m) = stocks(m) + CS%tr(i,j,k,m) * (G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k)) - enddo ; enddo ; enddo - stocks(m) = stock_scale * stocks(m) + stocks(m) = global_mass_int_EFP(h, G, GV, CS%tr(:,:,:,m), on_PE_only=.true.) enddo USER_tracer_stock = NTR From a468bee03702df5816a02580b5f46d9fcca971b1 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 23 Feb 2022 16:31:16 -0500 Subject: [PATCH 66/73] Removed trailing white space Removed trailing white space on two lines. All answers are bitwise identical. --- src/core/MOM_checksum_packages.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index 3951dfdc7d..d9855a98d3 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -294,8 +294,8 @@ subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, GV, US, allowChange, pe T%average = T%average + dV*Temp(i,j,k) S%minimum = min( S%minimum, Salt(i,j,k) ) ; S%maximum = max( S%maximum, Salt(i,j,k) ) S%average = S%average + dV*Salt(i,j,k) - tmp_T(i,j) = tmp_T(i,j) + dV*Temp(i,j,k) - tmp_S(i,j) = tmp_S(i,j) + dV*Salt(i,j,k) + tmp_T(i,j) = tmp_T(i,j) + dV*Temp(i,j,k) + tmp_S(i,j) = tmp_S(i,j) + dV*Salt(i,j,k) endif if (h_minimum > h(i,j,k)) h_minimum = h(i,j,k) endif From 9caa7010fc1e57c48cb2549fc174062d22b9ffd8 Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Wed, 23 Feb 2022 10:31:29 -0500 Subject: [PATCH 67/73] (+) Refactor of MOM_file_parser This patch includes several minor changes to the MOM_file_parser and supporting modules in order to accommodate stronger unit testing. It includes the following API changes: - Removal of `static_value` from `get_param` - Redefined `link_parameter` and `parameter_block` as private - New functions: `all_across_PEs()`, `any_across_PEs()` `static_value` was not used in any known experiments (outside of internal GFDL testing), and the two derived types describe internal operations within `MOM_file_parser`, so we do not expect any disruptions from these changes. A detailed summary of the changes are listed below. - `assert()` is now used to detect same files with different IO units. Detection of reopenend files of the same name but different IO unit has been changed from `MOM_error(FATAL, ...)` to `assert()`, to reflect that this should be a logically impossible result. - Bugfix: Reopened files are now reported to all PEs. If an open file is re-opened, then only the root PE will detect this and will `return` immediately. However, the others will proceed into `populate_param_data` and will get stuck in a broadcast waiting for root. We fix this by communicating the reopened state to all PEs and allow all ranks to return before re-processing the data. Note that this could also be resolved by allowing all ranks to track IO unit numbers, but for now we do not attempt to change this behavior. - `newunit=` used to generate parameter file IO unit The parameter IO unit is now generated by `newunit=` rather than an explicit search for an unused IO unit. Note that this is a Fortran 2008 feature. Testing around available IO units has also been removed. - Removal of generic IO error handling Generic "IO error" tests, and corresponding `err=` arguments, have been removed in most cases. We now rely on the Fortran runtime to provide diagnostics on these errors, which should typically exceed any information that MOM6 could provide. - Removal of purported `namelist` support There were several blocks of code provided to support namelist syntax, but did not appear to be working, nor was there any known instance of it being used by anyone, so it has been removed. - `#define/undef/=` syntax testing across ranks Previously, only the root PE would test for consistency of the #define-like syntax, even though all ranks have this information. This required a second, awkwardly placed syntax test later in the subroutine. This test is redefined to run over all ranks, and the subsequent test has been removed. - `define/override` test reordering The `found_override` test when coupled to a `#define`-like declaration was unreachable due to the presence of an even stronger test related to valid syntax. This test has been moved to provide more detailed information about the nature of the error. - `link_parameter`, `parameter_block` defined as private Internal derived types of `MOM_file_parser` are redefined as private. This preserves the integrity of instances of these types, and also prevents creation of implicit object code required to access them externally. - Removal of `static_value` from `get_param` interface The `static_value` argument of `get_param` has been removed, since it is functionally equivalent to `default`. While this is an API change, there is no known case of anyone using this argument. - The `param_type%doc` fields are now properly deallocated after closed. - Quotes have been added around some filename error warnings, to help detect issues related to whitespace. - `any_across_PEs` and `all_across_PEs` New functions for calling `any()` and `all()` across PE ranks have been added. Behavior is in line with other functions, such as `min_across_PEs`. --- config_src/infra/FMS1/MOM_coms_infra.F90 | 31 ++++ config_src/infra/FMS2/MOM_coms_infra.F90 | 31 ++++ src/core/MOM_verticalGrid.F90 | 2 +- src/framework/MOM_coms.F90 | 2 + src/framework/MOM_domains.F90 | 8 +- src/framework/MOM_file_parser.F90 | 186 +++++++---------------- 6 files changed, 123 insertions(+), 137 deletions(-) diff --git a/config_src/infra/FMS1/MOM_coms_infra.F90 b/config_src/infra/FMS1/MOM_coms_infra.F90 index 555b4df119..561cf6c333 100644 --- a/config_src/infra/FMS1/MOM_coms_infra.F90 +++ b/config_src/infra/FMS1/MOM_coms_infra.F90 @@ -16,6 +16,7 @@ module MOM_coms_infra public :: PE_here, root_PE, num_PEs, set_rootPE, Set_PElist, Get_PElist public :: broadcast, sum_across_PEs, min_across_PEs, max_across_PEs +public :: any_across_PEs, all_across_PEs public :: field_chksum, MOM_infra_init, MOM_infra_end ! This module provides interfaces to the non-domain-oriented communication @@ -438,6 +439,36 @@ subroutine min_across_PEs_real_1d(field, length, pelist) call mpp_min(field, length, pelist) end subroutine min_across_PEs_real_1d +!> Implementation of any() intrinsic across PEs +function any_across_PEs(field, pelist) + logical, intent(in) :: field !< Local PE value + integer, optional, intent(in) :: pelist(:) !< List of PEs to work with + logical :: any_across_PEs + + integer :: field_flag + + ! FMS1 does not support logical collectives, so integer flags are used. + field_flag = 0 + if (field) field_flag = 1 + call max_across_PEs(field_flag, pelist) + any_across_PEs = (field_flag > 0) +end function any_across_PEs + +!> Implementation of all() intrinsic across PEs +function all_across_PEs(field, pelist) + logical, intent(in) :: field !< Local PE value + integer, optional, intent(in) :: pelist(:) !< List of PEs to work with + logical :: all_across_PEs + + integer :: field_flag + + ! FMS1 does not support logical collectives, so integer flags are used. + field_flag = 0 + if (field) field_flag = 1 + call min_across_PEs(field_flag, pelist) + all_across_PEs = (field_flag > 0) +end function all_across_PEs + !> Initialize the model framework, including PE communication over a designated communicator. !! If no communicator ID is provided, the framework's default communicator is used. subroutine MOM_infra_init(localcomm) diff --git a/config_src/infra/FMS2/MOM_coms_infra.F90 b/config_src/infra/FMS2/MOM_coms_infra.F90 index 555b4df119..561cf6c333 100644 --- a/config_src/infra/FMS2/MOM_coms_infra.F90 +++ b/config_src/infra/FMS2/MOM_coms_infra.F90 @@ -16,6 +16,7 @@ module MOM_coms_infra public :: PE_here, root_PE, num_PEs, set_rootPE, Set_PElist, Get_PElist public :: broadcast, sum_across_PEs, min_across_PEs, max_across_PEs +public :: any_across_PEs, all_across_PEs public :: field_chksum, MOM_infra_init, MOM_infra_end ! This module provides interfaces to the non-domain-oriented communication @@ -438,6 +439,36 @@ subroutine min_across_PEs_real_1d(field, length, pelist) call mpp_min(field, length, pelist) end subroutine min_across_PEs_real_1d +!> Implementation of any() intrinsic across PEs +function any_across_PEs(field, pelist) + logical, intent(in) :: field !< Local PE value + integer, optional, intent(in) :: pelist(:) !< List of PEs to work with + logical :: any_across_PEs + + integer :: field_flag + + ! FMS1 does not support logical collectives, so integer flags are used. + field_flag = 0 + if (field) field_flag = 1 + call max_across_PEs(field_flag, pelist) + any_across_PEs = (field_flag > 0) +end function any_across_PEs + +!> Implementation of all() intrinsic across PEs +function all_across_PEs(field, pelist) + logical, intent(in) :: field !< Local PE value + integer, optional, intent(in) :: pelist(:) !< List of PEs to work with + logical :: all_across_PEs + + integer :: field_flag + + ! FMS1 does not support logical collectives, so integer flags are used. + field_flag = 0 + if (field) field_flag = 1 + call min_across_PEs(field_flag, pelist) + all_across_PEs = (field_flag > 0) +end function all_across_PEs + !> Initialize the model framework, including PE communication over a designated communicator. !! If no communicator ID is provided, the framework's default communicator is used. subroutine MOM_infra_init(localcomm) diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index b856cff3dc..a340b5f80f 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -142,7 +142,7 @@ subroutine verticalGridInit( param_file, GV, US ) ! Here NK_ is a macro, while nk is a variable. call get_param(param_file, mdl, "NK", nk, & "The number of model layers.", units="nondim", & - static_value=NK_) + default=NK_) if (nk /= NK_) call MOM_error(FATAL, "verticalGridInit: " // & "Mismatched number of layers NK_ between MOM_memory.h and param_file") diff --git a/src/framework/MOM_coms.F90 b/src/framework/MOM_coms.F90 index c3ed3ba7b3..9e4b811a46 100644 --- a/src/framework/MOM_coms.F90 +++ b/src/framework/MOM_coms.F90 @@ -7,12 +7,14 @@ module MOM_coms use MOM_coms_infra, only : PE_here, root_PE, num_PEs, set_rootPE, Set_PElist, Get_PElist use MOM_coms_infra, only : broadcast, field_chksum, MOM_infra_init, MOM_infra_end use MOM_coms_infra, only : sum_across_PEs, max_across_PEs, min_across_PEs +use MOM_coms_infra, only : all_across_PEs, any_across_PEs use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING implicit none ; private public :: PE_here, root_PE, num_PEs, MOM_infra_init, MOM_infra_end public :: broadcast, sum_across_PEs, min_across_PEs, max_across_PEs, field_chksum +public :: all_across_PEs, any_across_PEs public :: set_PElist, Get_PElist, Set_rootPE public :: reproducing_sum, reproducing_sum_EFP, EFP_sum_across_PEs, EFP_list_sum_across_PEs public :: EFP_plus, EFP_minus, EFP_to_real, real_to_EFP, EFP_real_diff diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 0cdcc455fc..dc6c0a8996 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -220,11 +220,11 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & call get_param(param_file, mdl, "NIGLOBAL", n_global(1), & "The total number of thickness grid points in the x-direction in the physical "//& "domain. With STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.", & - static_value=NIGLOBAL) + default=NIGLOBAL) call get_param(param_file, mdl, "NJGLOBAL", n_global(2), & "The total number of thickness grid points in the y-direction in the physical "//& "domain. With STATIC_MEMORY_ this is set in "//trim(inc_nm)//" at compile time.", & - static_value=NJGLOBAL) + default=NJGLOBAL) if (n_global(1) /= NIGLOBAL) call MOM_error(FATAL,"MOM_domains_init: " // & "static mismatch for NIGLOBAL_ domain size. Header file does not match input namelist") if (n_global(2) /= NJGLOBAL) call MOM_error(FATAL,"MOM_domains_init: " // & @@ -256,11 +256,11 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & call get_param(param_file, mdl, trim(nihalo_nm), n_halo(1), & "The number of halo points on each side in the x-direction. How this is set "//& "varies with the calling component and static or dynamic memory configuration.", & - default=nihalo_dflt, static_value=nihalo_dflt) + default=nihalo_dflt) call get_param(param_file, mdl, trim(njhalo_nm), n_halo(2), & "The number of halo points on each side in the y-direction. How this is set "//& "varies with the calling component and static or dynamic memory configuration.", & - default=njhalo_dflt, static_value=njhalo_dflt) + default=njhalo_dflt) if (present(min_halo)) then n_halo(1) = max(n_halo(1), min_halo(1)) min_halo(1) = n_halo(1) diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index 07e9138594..3ad551496f 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -4,7 +4,8 @@ module MOM_file_parser ! This file is part of MOM6. See LICENSE.md for the license. use MOM_coms, only : root_PE, broadcast -use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg +use MOM_coms, only : any_across_PEs +use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, assert use MOM_error_handler, only : is_root_pe, stdlog, stdout use MOM_time_manager, only : get_time, time_type, get_ticks_per_second use MOM_time_manager, only : set_date, get_date, real_to_time, operator(-), set_time @@ -39,14 +40,14 @@ module MOM_file_parser end type file_data_type !> A link in the list of variables that have already had override warnings issued -type :: link_parameter ; private +type, private :: link_parameter ; private type(link_parameter), pointer :: next => NULL() !< Facilitates linked list character(len=80) :: name !< Parameter name logical :: hasIssuedOverrideWarning = .false. !< Has a default value end type link_parameter !> Specify the active parameter block -type :: parameter_block ; private +type, private :: parameter_block ; private character(len=240) :: name = '' !< The active parameter block name end type parameter_block @@ -125,7 +126,7 @@ subroutine open_param_file(filename, CS, checkable, component, doc_file_dir) !! the documentation files. The default is effectively './'. ! Local variables - logical :: file_exists, unit_in_use, Netcdf_file, may_check + logical :: file_exists, unit_in_use, Netcdf_file, may_check, reopened_file integer :: ios, iounit, strlen, i character(len=240) :: doc_path type(parameter_block), pointer :: block => NULL() @@ -140,30 +141,29 @@ subroutine open_param_file(filename, CS, checkable, component, doc_file_dir) ! Check that this file has not already been opened if (CS%nfiles > 0) then + reopened_file = .false. inquire(file=trim(filename), number=iounit) if (iounit /= -1) then do i = 1, CS%nfiles if (CS%iounit(i) == iounit) then - if (trim(CS%filename(1)) /= trim(filename)) then - call MOM_error(FATAL, & + call assert(trim(CS%filename(1)) == trim(filename), & "open_param_file: internal inconsistency! "//trim(filename)// & " is registered as open but has the wrong unit number!") - else - call MOM_error(WARNING, & + call MOM_error(WARNING, & "open_param_file: file "//trim(filename)// & " has already been opened. This should NOT happen!"// & " Did you specify the same file twice in a namelist?") - return - endif ! filenames + reopened_file = .true. endif ! unit numbers enddo ! i endif + if (any_across_PEs(reopened_file)) return endif ! Check that the file exists to readstdlog inquire(file=trim(filename), exist=file_exists) if (.not.file_exists) call MOM_error(FATAL, & - "open_param_file: Input file "// trim(filename)//" does not exist.") + "open_param_file: Input file '"// trim(filename)//"' does not exist.") Netcdf_file = .false. if (strlen > 3) then @@ -174,18 +174,10 @@ subroutine open_param_file(filename, CS, checkable, component, doc_file_dir) call MOM_error(FATAL,"open_param_file: NetCDF files are not yet supported.") if (all_PEs_read .or. is_root_pe()) then - ! Find an unused unit number. - do iounit=10,512 - INQUIRE(iounit,OPENED=unit_in_use) ; if (.not.unit_in_use) exit - enddo - if (iounit >= 512) call MOM_error(FATAL, & - "open_param_file: No unused file unit could be found.") - - ! Open the parameter file. - open(iounit, file=trim(filename), access='SEQUENTIAL', & + open(newunit=iounit, file=trim(filename), access='SEQUENTIAL', & form='FORMATTED', action='READ', position='REWIND', iostat=ios) - if (ios /= 0) call MOM_error(FATAL, "open_param_file: Error opening "// & - trim(filename)) + if (ios /= 0) call MOM_error(FATAL, "open_param_file: Error opening '"// & + trim(filename)//"'.") else iounit = 1 endif @@ -268,6 +260,7 @@ subroutine close_param_file(CS, quiet_close, component) enddo CS%log_open = .false. call doc_end(CS%doc) + deallocate(CS%doc) return endif ; endif @@ -341,7 +334,7 @@ subroutine close_param_file(CS, quiet_close, component) CS%log_open = .false. call doc_end(CS%doc) - + deallocate(CS%doc) end subroutine close_param_file !> Read the contents of a parameter input file, and store the contents in a @@ -361,8 +354,6 @@ subroutine populate_param_data(iounit, filename, param_data) ! Allocate the space to hold the lines in param_data%line ! Populate param_data%line with the keyword lines from parameter file - if (iounit <= 0) return - if (all_PEs_read .or. is_root_pe()) then ! rewind the parameter file rewind(iounit) @@ -371,7 +362,7 @@ subroutine populate_param_data(iounit, filename, param_data) num_lines = 0 inMultiLineComment = .false. do while(.true.) - read(iounit, '(a)', end=8, err=9) line + read(iounit, '(a)', end=8) line line = replaceTabs(line) if (inMultiLineComment) then if (closeMultiLineComment(line)) inMultiLineComment=.false. @@ -410,7 +401,7 @@ subroutine populate_param_data(iounit, filename, param_data) ! Populate param_data%line num_lines = 0 do while(.true.) - read(iounit, '(a)', end=18, err=9) line + read(iounit, '(a)', end=18) line line = replaceTabs(line) if (inMultiLineComment) then if (closeMultiLineComment(line)) inMultiLineComment=.false. @@ -426,21 +417,15 @@ subroutine populate_param_data(iounit, filename, param_data) enddo ! while (.true.) 18 continue ! get here when read() reaches EOF - if (num_lines /= param_data%num_lines) & - call MOM_error(FATAL, 'MOM_file_parser : Found different number of '// & - 'valid lines on second reading of '//trim(filename)) + call assert(num_lines == param_data%num_lines, & + 'MOM_file_parser: Found different number of valid lines on second ' & + // 'reading of '//trim(filename)) endif ! (is_root_pe()) ! Broadcast the populated array param_data%line if (.not. all_PEs_read) then call broadcast(param_data%line, INPUT_STR_LENGTH, root_pe()) endif - - return - -9 call MOM_error(FATAL, "MOM_file_parser : "//& - "Error while reading file "//trim(filename)) - end subroutine populate_param_data @@ -911,7 +896,7 @@ subroutine get_variable_line(CS, varname, found, defined, value_string, paramIsL character(len=INPUT_STR_LENGTH) :: val_str, lname, origLine character(len=INPUT_STR_LENGTH) :: line, continuationBuffer, blockName character(len=FILENAME_LENGTH) :: filename - integer :: is, id, isd, isu, ise, iso, verbose, ipf + integer :: is, id, isd, isu, ise, iso, ipf integer :: last, last1, ival, oval, max_vals, count, contBufSize character(len=52) :: set logical :: found_override, found_equals @@ -920,10 +905,10 @@ subroutine get_variable_line(CS, varname, found, defined, value_string, paramIsL logical :: variableKindIsLogical, valueIsSame logical :: inWrongBlock, fullPathParameter logical, parameter :: requireNamedClose = .false. + integer, parameter :: verbose = 1 set = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" continuationBuffer = repeat(" ",INPUT_STR_LENGTH) contBufSize = 0 - verbose = 1 variableKindIsLogical=.false. if (present(paramIsLogical)) variableKindIsLogical = paramIsLogical @@ -986,25 +971,6 @@ subroutine get_variable_line(CS, varname, found, defined, value_string, paramIsL line = trim(adjustl(line(iso+10:last))); last = len_trim(line) endif - ! Check for start of fortran namelist, ie. '&namelist' - if (index(line(:last),'&')==1) then - iso=index(line(:last),' ') - if (iso>0) then ! possibly simething else on this line - blockName = pushBlockLevel(blockName,line(2:iso-1)) - line=trim(adjustl(line(iso:last))) - last=len_trim(line) - if (last==0) cycle ! nothing else on this line - else ! just the namelist on this line - if (len_trim(blockName)>0) then - blockName = trim(blockName) // '%' //trim(line(2:last)) - else - blockName = trim(line(2:last)) - endif - call flag_line_as_read(CS%param_data(ipf)%line_used,count) - cycle - endif - endif - ! Newer form of parameter block, block%, %block or block%param or iso=index(line(:last),'%') fullPathParameter = .false. @@ -1042,14 +1008,6 @@ subroutine get_variable_line(CS, varname, found, defined, value_string, paramIsL if (trim(CS%blockName%name)/=trim(blockName)) inWrongBlock = .true. ! Not in the required block endif - ! Check for termination of a fortran namelist (with a '/') - if (line(last:last)=='/') then - if (len_trim(blockName)==0 .and. is_root_pe()) call MOM_error(FATAL, & - 'get_variable_line: An extra namelist/block end was encountered. Line="'// & - trim(line(:last))//'"' ) - blockName = popBlockLevel(blockName) - last = last - 1 ! Ignore the termination character from here on - endif if (inWrongBlock .and. .not. fullPathParameter) then if (index(" "//line(:last+1), " "//trim(varname)//" ")>0) & call MOM_error(WARNING,"MOM_file_parser : "//trim(varname)// & @@ -1069,29 +1027,28 @@ subroutine get_variable_line(CS, varname, found, defined, value_string, paramIsL if (index(line(:last), "#undef ")==1) found_undef = .true. ! Check for missing, mutually exclusive or incomplete keywords - if (is_root_pe()) then - if (.not. (found_define .or. found_undef .or. found_equals)) & - call MOM_error(FATAL, "MOM_file_parser : the parameter name '"// & - trim(varname)//"' was found without define or undef."// & - " Line: '"//trim(line(:last))//"'"//& - " in file "//trim(filename)//".") - if (found_define .and. found_undef) call MOM_error(FATAL, & - "MOM_file_parser : Both 'undef' and 'define' occur."// & - " Line: '"//trim(line(:last))//"'"//& - " in file "//trim(filename)//".") - if (found_equals .and. (found_define .or. found_undef)) & - call MOM_error(FATAL, & - "MOM_file_parser : Both 'a=b' and 'undef/define' syntax occur."// & - " Line: '"//trim(line(:last))//"'"//& - " in file "//trim(filename)//".") - if (found_override .and. .not. (found_define .or. found_undef .or. found_equals)) & - call MOM_error(FATAL, "MOM_file_parser : override was found "// & - " without a define or undef."// & - " Line: '"//trim(line(:last))//"'"//& - " in file "//trim(filename)//".") + if (.not. (found_define .or. found_undef .or. found_equals)) then + if (found_override) then + call MOM_error(FATAL, "MOM_file_parser : override was found " // & + " without a define or undef." // & + " Line: '" // trim(line(:last)) // "'" // & + " in file " // trim(filename) // ".") + else + call MOM_error(FATAL, "MOM_file_parser : the parameter name '" // & + trim(varname) // "' was found without define or undef." // & + " Line: '" // trim(line(:last)) // "'" // & + " in file " // trim(filename) // ".") + endif endif + if (found_equals .and. (found_define .or. found_undef)) & + call MOM_error(FATAL, & + "MOM_file_parser : Both 'a=b' and 'undef/define' syntax occur."// & + " Line: '"//trim(line(:last))//"'"//& + " in file "//trim(filename)//".") + ! Interpret the line and collect values, if any + ! NOTE: At least one of these must be true if (found_define) then ! Move starting pointer to first letter of defined name. is = isd + 5 + scan(line(isd+6:last), set) @@ -1131,10 +1088,6 @@ subroutine get_variable_line(CS, varname, found, defined, value_string, paramIsL defined_in_line = .true. endif found = .true. - else - call MOM_error(FATAL, "MOM_file_parser (non-root PE?): the parameter name '"// & - trim(varname)//"' was found without an assignment, define or undef."// & - " Line: '"//trim(line(:last))//"'"//" in file "//trim(filename)//".") endif ! This line has now been used. @@ -1201,6 +1154,7 @@ subroutine get_variable_line(CS, varname, found, defined, value_string, paramIsL ival = ival + 1 value_string(ival) = trim(val_str) defined = defined_in_line + if (verbose > 1 .and. is_root_pe()) & call MOM_error(WARNING,"MOM_file_parser : "//trim(varname)// & " set. Line: '"//trim(line(:last))//"'"//& @@ -1628,7 +1582,7 @@ end function convert_date_to_string !! and logs it in documentation files. subroutine get_param_int(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & - static_value, layoutParam, debuggingParam) + layoutParam, debuggingParam) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1639,9 +1593,6 @@ subroutine get_param_int(CS, modulename, varname, value, desc, units, & !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter integer, optional, intent(in) :: default !< The default value of the parameter - integer, optional, intent(in) :: static_value !< If this parameter is static, it takes - !! this value, which can be compared for consistency with - !! what is in the parameter file. logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file logical, optional, intent(in) :: do_not_read !< If present and true, do not read a @@ -1660,7 +1611,6 @@ subroutine get_param_int(CS, modulename, varname, value, desc, units, & if (do_read) then if (present(default)) value = default - if (present(static_value)) value = static_value call read_param_int(CS, varname, value, fail_if_missing) endif @@ -1675,7 +1625,7 @@ end subroutine get_param_int !! and logs them in documentation files. subroutine get_param_int_array(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & - static_value, layoutParam, debuggingParam) + layoutParam, debuggingParam) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1686,9 +1636,6 @@ subroutine get_param_int_array(CS, modulename, varname, value, desc, units, & !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter integer, optional, intent(in) :: default !< The default value of the parameter - integer, optional, intent(in) :: static_value !< If this parameter is static, it takes - !! this value, which can be compared for consistency with - !! what is in the parameter file. logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file logical, optional, intent(in) :: do_not_read !< If present and true, do not read a @@ -1706,8 +1653,7 @@ subroutine get_param_int_array(CS, modulename, varname, value, desc, units, & do_log = .true. ; if (present(do_not_log)) do_log = .not.do_not_log if (do_read) then - if (present(default)) then ; value(:) = default ; endif - if (present(static_value)) then ; value(:) = static_value ; endif + if (present(default)) value(:) = default call read_param_int_array(CS, varname, value, fail_if_missing) endif @@ -1722,7 +1668,7 @@ end subroutine get_param_int_array !! and logs it in documentation files. subroutine get_param_real(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & - static_value, debuggingParam, scale, unscaled) + debuggingParam, scale, unscaled) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1733,9 +1679,6 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, & !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter - real, optional, intent(in) :: static_value !< If this parameter is static, it takes - !! this value, which can be compared for consistency with - !! what is in the parameter file. logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file logical, optional, intent(in) :: do_not_read !< If present and true, do not read a @@ -1756,7 +1699,6 @@ subroutine get_param_real(CS, modulename, varname, value, desc, units, & if (do_read) then if (present(default)) value = default - if (present(static_value)) value = static_value call read_param_real(CS, varname, value, fail_if_missing) endif @@ -1774,7 +1716,7 @@ end subroutine get_param_real !! and logs them in documentation files. subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, debuggingParam, & - static_value, scale, unscaled) + scale, unscaled) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1785,9 +1727,6 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter real, optional, intent(in) :: default !< The default value of the parameter - real, optional, intent(in) :: static_value !< If this parameter is static, it takes - !! this value, which can be compared for consistency with - !! what is in the parameter file. logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file logical, optional, intent(in) :: do_not_read !< If present and true, do not read a @@ -1807,8 +1746,7 @@ subroutine get_param_real_array(CS, modulename, varname, value, desc, units, & do_log = .true. ; if (present(do_not_log)) do_log = .not.do_not_log if (do_read) then - if (present(default)) then ; value(:) = default ; endif - if (present(static_value)) then ; value(:) = static_value ; endif + if (present(default)) value(:) = default call read_param_real_array(CS, varname, value, fail_if_missing) endif @@ -1826,7 +1764,7 @@ end subroutine get_param_real_array !! and logs it in documentation files. subroutine get_param_char(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & - static_value, layoutParam, debuggingParam) + layoutParam, debuggingParam) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1837,9 +1775,6 @@ subroutine get_param_char(CS, modulename, varname, value, desc, units, & !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter character(len=*), optional, intent(in) :: default !< The default value of the parameter - character(len=*), optional, intent(in) :: static_value !< If this parameter is static, it takes - !! this value, which can be compared for consistency with - !! what is in the parameter file. logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file logical, optional, intent(in) :: do_not_read !< If present and true, do not read a @@ -1858,7 +1793,6 @@ subroutine get_param_char(CS, modulename, varname, value, desc, units, & if (do_read) then if (present(default)) value = default - if (present(static_value)) value = static_value call read_param_char(CS, varname, value, fail_if_missing) endif @@ -1872,7 +1806,7 @@ end subroutine get_param_char !> This subroutine reads the values of an array of character string model parameters !! from a parameter file and logs them in documentation files. subroutine get_param_char_array(CS, modulename, varname, value, desc, units, & - default, fail_if_missing, do_not_read, do_not_log, static_value) + default, fail_if_missing, do_not_read, do_not_log) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1883,9 +1817,6 @@ subroutine get_param_char_array(CS, modulename, varname, value, desc, units, & !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter character(len=*), optional, intent(in) :: default !< The default value of the parameter - character(len=*), optional, intent(in) :: static_value !< If this parameter is static, it takes - !! this value, which can be compared for consistency with - !! what is in the parameter file. logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file logical, optional, intent(in) :: do_not_read !< If present and true, do not read a @@ -1902,8 +1833,7 @@ subroutine get_param_char_array(CS, modulename, varname, value, desc, units, & do_log = .true. ; if (present(do_not_log)) do_log = .not.do_not_log if (do_read) then - if (present(default)) then ; value(:) = default ; endif - if (present(static_value)) then ; value(:) = static_value ; endif + if (present(default)) value(:) = default call read_param_char_array(CS, varname, value, fail_if_missing) endif @@ -1926,7 +1856,7 @@ end subroutine get_param_char_array !! and logs it in documentation files. subroutine get_param_logical(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & - static_value, layoutParam, debuggingParam) + layoutParam, debuggingParam) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters character(len=*), intent(in) :: modulename !< The name of the calling module @@ -1937,9 +1867,6 @@ subroutine get_param_logical(CS, modulename, varname, value, desc, units, & !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter logical, optional, intent(in) :: default !< The default value of the parameter - logical, optional, intent(in) :: static_value !< If this parameter is static, it takes - !! this value, which can be compared for consistency with - !! what is in the parameter file. logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file logical, optional, intent(in) :: do_not_read !< If present and true, do not read a @@ -1958,7 +1885,6 @@ subroutine get_param_logical(CS, modulename, varname, value, desc, units, & if (do_read) then if (present(default)) value = default - if (present(static_value)) value = static_value call read_param_logical(CS, varname, value, fail_if_missing) endif @@ -1973,7 +1899,7 @@ end subroutine get_param_logical !! and logs it in documentation files. subroutine get_param_time(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & - timeunit, static_value, layoutParam, debuggingParam, & + timeunit, layoutParam, debuggingParam, & log_as_date) type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module, !! it is also a structure to parse for run-time parameters @@ -1985,9 +1911,6 @@ subroutine get_param_time(CS, modulename, varname, value, desc, units, & !! present, this parameter is not written to a doc file character(len=*), optional, intent(in) :: units !< The units of this parameter type(time_type), optional, intent(in) :: default !< The default value of the parameter - type(time_type), optional, intent(in) :: static_value !< If this parameter is static, it takes - !! this value, which can be compared for consistency with - !! what is in the parameter file. logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs !! if this variable is not found in the parameter file logical, optional, intent(in) :: do_not_read !< If present and true, do not read a @@ -2011,7 +1934,6 @@ subroutine get_param_time(CS, modulename, varname, value, desc, units, & if (do_read) then if (present(default)) value = default - if (present(static_value)) value = static_value call read_param_time(CS, varname, value, timeunit, fail_if_missing, date_format=log_date) endif From 9a01cd501d00df2c9b2b8cf3f880fd4d8336ff53 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 26 Feb 2022 02:37:29 -0500 Subject: [PATCH 68/73] +Add ALE options mimicking Hycom Added a number of options to MOM_ALE to mimic options that are found in Hycom. By default, all answers are bitwise identical, but there are several new runtime parameters. The code changes include: . Added the ability to use a different remapping scheme for velocities than for tracers, using the new runtime parameter VELOCITY_REMAPPING_SCHEME . Added the new runtime option PARTIAL_CELL_VELOCITY_REMAP to use partial cell thicknesses for remapping at velocity points, which triggers a call to the new internal routine apply_partial_cell_mask. . Added the new internal routine mask_near_bottom_vel to allow MOM6 to mimic Hycom in zeroing out the velocities in thin layers in a bottom boundary layer with a thickness given by the new runtime parameter REMAP_VEL_MASK_BBL_THICK, while the definition of thin is specified by REMAP_VEL_MASK_H_THIN. Setting these to be negative (as is the default) avoids this. . Modified the interface to remap_all_state_vars to take just the ALE_CS, which then provides the remapping control structure that is appropriate for the tracers or velocities, rather than also passing this in as an argument. . Eliminated some unnecessary internal variables, and added others to be more explicit avoid array syntax copies in arguments. --- src/ALE/MOM_ALE.F90 | 348 ++++++++++++++++++++++++++++++-------------- 1 file changed, 239 insertions(+), 109 deletions(-) diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 72afad16df..46669c20cb 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -10,7 +10,7 @@ module MOM_ALE ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_debugging, only : check_column_integrals +use MOM_debugging, only : check_column_integrals, hchksum, uvchksum use MOM_diag_mediator, only : register_diag_field, post_data, diag_ctrl use MOM_diag_mediator, only : time_type, diag_update_remap_grids use MOM_diag_vkernels, only : interpolate_column, reintegrate_column @@ -64,14 +64,26 @@ module MOM_ALE logical :: remap_uv_using_old_alg !< If true, uses the old "remapping via a delta z" !! method. If False, uses the new method that !! remaps between grids described by h. + logical :: partial_cell_vel_remap !< If true, use partial cell thicknesses at velocity points + !! that are masked out where they extend below the shallower + !! of the neighboring bathymetry for remapping velocity. real :: regrid_time_scale !< The time-scale used in blending between the current (old) grid !! and the target (new) grid [T ~> s] type(regridding_CS) :: regridCS !< Regridding parameters and work arrays type(remapping_CS) :: remapCS !< Remapping parameters and work arrays + type(remapping_CS) :: vel_remapCS !< Remapping parameters for velocities and work arrays integer :: nk !< Used only for queries, not directly by this module + real :: BBL_h_vel_mask !< The thickness of a bottom boundary layer within which velocities in + !! thin layers are zeroed out after remapping, following practice with + !! Hybgen remapping, or a negative value to avoid such filtering + !! altogether, in [H ~> m or kg m-2]. + real :: h_vel_mask !< A thickness at velocity points below which near-bottom layers are + !! zeroed out after remapping, following the practice with Hybgen + !! remapping, or a negative value to avoid such filtering altogether, + !! in [H ~> m or kg m-2]. logical :: remap_after_initialization !< Indicates whether to regrid/remap after initializing the state. @@ -79,6 +91,7 @@ module MOM_ALE !! that recover the answers from the end of 2018. Otherwise, use more !! robust and accurate forms of mathematically equivalent expressions. + logical :: debug !< If true, write verbose checksums for debugging purposes. logical :: show_call_tree !< For debugging ! for diagnostics @@ -144,16 +157,16 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) type(ALE_CS), pointer :: CS !< Module control structure ! Local variables - real, dimension(:), allocatable :: dz - character(len=40) :: mdl = "MOM_ALE" ! This module's name. - character(len=80) :: string ! Temporary strings - real :: filter_shallow_depth, filter_deep_depth - logical :: default_2018_answers - logical :: check_reconstruction - logical :: check_remapping - logical :: force_bounds_in_subcell - logical :: local_logical - logical :: remap_boundary_extrap + real, allocatable :: dz(:) + character(len=40) :: mdl = "MOM_ALE" ! This module's name. + character(len=80) :: string, vel_string ! Temporary strings + real :: filter_shallow_depth, filter_deep_depth + logical :: default_2018_answers + logical :: check_reconstruction + logical :: check_remapping + logical :: force_bounds_in_subcell + logical :: local_logical + logical :: remap_boundary_extrap if (associated(CS)) then call MOM_error(WARNING, "ALE_init called with an associated "// & @@ -174,12 +187,17 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) ! Initialize and configure regridding call ALE_initRegridding(GV, US, max_depth, param_file, mdl, CS%regridCS) - ! Initialize and configure remapping + ! Initialize and configure remapping that is orchestrated by ALE. call get_param(param_file, mdl, "REMAPPING_SCHEME", string, & "This sets the reconstruction scheme used "//& "for vertical remapping for all variables. "//& "It can be one of the following schemes: "//& trim(remappingSchemesDoc), default=remappingDefaultScheme) + call get_param(param_file, mdl, "VELOCITY_REMAPPING_SCHEME", vel_string, & + "This sets the reconstruction scheme used for vertical remapping "//& + "of velocities. By default it is the same as REMAPPING_SCHEME. "//& + "It can be one of the following schemes: "//& + trim(remappingSchemesDoc), default=trim(string)) call get_param(param_file, mdl, "FATAL_CHECK_RECONSTRUCTIONS", check_reconstruction, & "If true, cell-by-cell reconstructions are checked for "//& "consistency and if non-monotonicity or an inconsistency is "//& @@ -208,6 +226,17 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) check_remapping=check_remapping, & force_bounds_in_subcell=force_bounds_in_subcell, & answers_2018=CS%answers_2018) + call initialize_remapping( CS%vel_remapCS, vel_string, & + boundary_extrapolation=remap_boundary_extrap, & + check_reconstruction=check_reconstruction, & + check_remapping=check_remapping, & + force_bounds_in_subcell=force_bounds_in_subcell, & + answers_2018=CS%answers_2018) + + call get_param(param_file, mdl, "PARTIAL_CELL_VELOCITY_REMAP", CS%partial_cell_vel_remap, & + "If true, use partial cell thicknesses at velocity points that are masked out "//& + "where they extend below the shallower of the neighboring bathymetry for "//& + "remapping velocity.", default=.false.) call get_param(param_file, mdl, "REMAP_AFTER_INITIALIZATION", CS%remap_after_initialization, & "If true, applies regridding and remapping immediately after "//& @@ -239,6 +268,21 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) "code.", default=.true., do_not_log=.true.) call set_regrid_params(CS%regridCS, integrate_downward_for_e=.not.local_logical) + call get_param(param_file, mdl, "REMAP_VEL_MASK_BBL_THICK", CS%BBL_h_vel_mask, & + "A thickness of a bottom boundary layer below which velocities in thin layers "//& + "are zeroed out after remapping, following practice with Hybgen remapping, "//& + "or a negative value to avoid such filtering altogether.", & + default=-0.001, units="m", scale=GV%m_to_H) + call get_param(param_file, mdl, "REMAP_VEL_MASK_H_THIN", CS%h_vel_mask, & + "A thickness at velocity points below which near-bottom layers are zeroed out "//& + "after remapping, following practice with Hybgen remapping, or a negative value "//& + "to avoid such filtering altogether.", & + default=1.0e-6, units="m", scale=GV%m_to_H, do_not_log=(CS%BBL_h_vel_mask<=0.0)) + + call get_param(param_file, "MOM", "DEBUG", CS%debug, & + "If true, write out verbose debugging data.", & + default=.false., debuggingParam=.true.) + ! Keep a record of values for subsequent queries CS%nk = GV%ke @@ -307,6 +351,7 @@ subroutine ALE_end(CS) ! Deallocate memory used for the regridding call end_remapping( CS%remapCS ) + call end_regridding( CS%regridCS ) deallocate(CS) @@ -335,13 +380,10 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, OBC, dt, frac_shelf_h) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta_preale real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_new ! New 3D grid obtained after last time step [H ~> m or kg m-2] - integer :: nk, i, j, k, isc, iec, jsc, jec - logical :: ice_shelf + integer :: nk, i, j, k, isc, iec, jsc, jec, ntr nk = GV%ke; isc = G%isc; iec = G%iec; jsc = G%jsc; jec = G%jec - ice_shelf = present(frac_shelf_h) - if (CS%show_call_tree) call callTree_enter("ALE_main(), MOM_ALE.F90") ! These diagnostics of the state before ALE is applied are mostly used for debugging. @@ -362,11 +404,8 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, OBC, dt, frac_shelf_h) ! Build new grid. The new grid is stored in h_new. The old grid is h. ! Both are needed for the subsequent remapping of variables. - if (ice_shelf) then - call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid, frac_shelf_h) - else - call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid) - endif + call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid, & + frac_shelf_h ) call check_grid( G, GV, h, 0. ) @@ -377,23 +416,30 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, OBC, dt, frac_shelf_h) if (present(dt)) then call diag_update_remap_grids(CS%diag) endif + ! Remap all variables from old grid h onto new grid h_new - call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_new, Reg, OBC, dzRegrid, & - u, v, CS%show_call_tree, dt ) + call remap_all_state_vars( CS, G, GV, h, h_new, Reg, OBC, dzRegrid, u, v, & + CS%show_call_tree, dt ) if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_main)") ! Override old grid with new one. The new grid 'h_new' is built in ! one of the 'build_...' routines above. !$OMP parallel do default(shared) - do k = 1,nk ; do j = jsc-1,jec+1 ; do i = isc-1,iec+1 + do k=1,nk ; do j=jsc-1,jec+1 ; do i=isc-1,iec+1 h(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo - if (CS%show_call_tree) call callTree_leave("ALE_main()") + if (CS%debug) then + call hchksum(h, "Post-ALE_main h", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(tv%T, "Post-ALE_main T", G%HI, haloshift=0) + call hchksum(tv%S, "Post-ALE_main S", G%HI, haloshift=0) + call uvchksum("Post-ALE_main [uv]", u, v, G%HI, haloshift=0, scale=US%L_T_to_m_s) + endif if (CS%id_dzRegrid>0 .and. present(dt)) call post_data(CS%id_dzRegrid, dzRegrid, CS%diag) + if (CS%show_call_tree) call callTree_leave("ALE_main()") end subroutine ALE_main @@ -435,8 +481,7 @@ subroutine ALE_main_offline( G, GV, h, tv, Reg, CS, OBC, dt) ! Remap all variables from old grid h onto new grid h_new - call remap_all_state_vars(CS%remapCS, CS, G, GV, h, h_new, Reg, OBC, & - debug=CS%show_call_tree, dt=dt ) + call remap_all_state_vars( CS, G, GV, h, h_new, Reg, OBC, debug=CS%show_call_tree, dt=dt ) if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_main)") @@ -484,12 +529,12 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC) ! Build new grid from the Zstar state onto the requested vertical coordinate. The new grid is stored ! in h_new. The old grid is h. Both are needed for the subsequent remapping of variables. Convective ! adjustment right now is not used because it is unclear what to do with vanished layers - call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid, conv_adjust = .false. ) + call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid, conv_adjust=.false. ) call check_grid( G, GV, h_new, 0. ) if (CS%show_call_tree) call callTree_waypoint("new grid generated (ALE_offline_inputs)") ! Remap all variables from old grid h onto new grid h_new - call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_new, Reg, OBC, debug=CS%show_call_tree ) + call remap_all_state_vars( CS, G, GV, h, h_new, Reg, OBC, debug=CS%show_call_tree ) if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_inputs)") ! Reintegrate mass transports from Zstar to the offline vertical coordinate @@ -565,7 +610,7 @@ subroutine ALE_offline_tracer_final( G, GV, h, tv, h_target, Reg, CS, OBC) ! Remap all variables from old grid h onto new grid h_new - call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_new, Reg, OBC, debug=CS%show_call_tree ) + call remap_all_state_vars( CS, G, GV, h, h_new, Reg, OBC, debug=CS%show_call_tree ) if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_offline_tracer_final)") @@ -607,6 +652,7 @@ subroutine check_grid( G, GV, h, threshold ) end subroutine check_grid +!### This routine does not appear to be used. !> Generates new grid subroutine ALE_build_grid( G, GV, regridCS, remapCS, h, tv, debug, frac_shelf_h ) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure @@ -622,20 +668,15 @@ subroutine ALE_build_grid( G, GV, regridCS, remapCS, h, tv, debug, frac_shelf_h integer :: nk, i, j, k real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: h_new ! The new grid thicknesses - logical :: show_call_tree, use_ice_shelf + logical :: show_call_tree show_call_tree = .false. if (present(debug)) show_call_tree = debug if (show_call_tree) call callTree_enter("ALE_build_grid(), MOM_ALE.F90") - use_ice_shelf = present(frac_shelf_h) ! Build new grid. The new grid is stored in h_new. The old grid is h. ! Both are needed for the subsequent remapping of variables. - if (use_ice_shelf) then - call regridding_main( remapCS, regridCS, G, GV, h, tv, h_new, dzRegrid, frac_shelf_h ) - else - call regridding_main( remapCS, regridCS, G, GV, h, tv, h_new, dzRegrid ) - endif + call regridding_main( remapCS, regridCS, G, GV, h, tv, h_new, dzRegrid, frac_shelf_h ) ! Override old grid with new one. The new grid 'h_new' is built in ! one of the 'build_...' routines above. @@ -722,7 +763,7 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n, u, v, OBC, Reg, dt, dzReg enddo ! remap all state variables (including those that weren't needed for regridding) - call remap_all_state_vars(CS%remapCS, CS, G, GV, h_orig, h, Reg, OBC, dzIntTotal, u, v) + call remap_all_state_vars(CS, G, GV, h_orig, h, Reg, OBC, dzIntTotal, u, v) ! save total dzregrid for diags if needed? if (present(dzRegrid)) dzRegrid(:,:,:) = dzIntTotal(:,:,:) @@ -734,10 +775,9 @@ end subroutine ALE_regrid_accelerated !! This routine is called during initialization of the model at time=0, to !! remap initial conditions to the model grid. It is also called during a !! time step to update the state. -subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, OBC, & - dzInterface, u, v, debug, dt) - type(remapping_CS), intent(in) :: CS_remapping !< Remapping control structure - type(ALE_CS), intent(in) :: CS_ALE !< ALE control structure +subroutine remap_all_state_vars(CS, G, GV, h_old, h_new, Reg, OBC, & + dzInterface, u, v, debug, dt ) + type(ALE_CS), intent(in) :: CS !< ALE control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid @@ -757,36 +797,41 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, real, optional, intent(in) :: dt !< time step for diagnostics [T ~> s] ! Local variables + real, dimension(SZI_(G),SZJ_(G)) :: h_tot ! The vertically summed thicknesses [H ~> m or kg m-2] + real :: h_mask_vel ! A depth below which the thicknesses at a velocity point are masked out [H ~> m or kg m-2] real, dimension(GV%ke+1) :: dz ! The change in interface heights interpolated to ! a velocity point [H ~> m or kg m-2] - real, dimension(GV%ke) :: h1 ! A column of initial thicknesses [H ~> m or kg m-2] - real, dimension(GV%ke) :: h2 ! A column of updated thicknesses [H ~> m or kg m-2] - real, dimension(GV%ke) :: u_column ! A column of properties, like tracer concentrations - ! or velocities, being remapped [various units] - real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: work_conc ! The rate of change of concentrations [Conc T-1 ~> Conc s-1] - real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: work_cont ! The rate of change of cell-integrated tracer - ! content [Conc H T-1 ~> Conc m s-1 or Conc kg m-2 s-1] or - ! cell thickness [H T-1 ~> m s-1 or Conc kg m-2 s-1] - real, dimension(SZI_(G), SZJ_(G)) :: work_2d ! The rate of change of column-integrated tracer - ! content [Conc H T-1 ~> Conc m s-1 or Conc kg m-2 s-1] - real :: Idt ! The inverse of the timestep [T-1 ~> s-1] + real :: tr_column(GV%ke) ! A column of updated tracer concentrations + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: work_conc ! The rate of change of concentrations [Conc T-1 ~> Conc s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: work_cont ! The rate of change of cell-integrated tracer + ! content [Conc H T-1 ~> Conc m s-1 or Conc kg m-2 s-1] or + ! cell thickness [H T-1 ~> m s-1 or Conc kg m-2 s-1] + real, dimension(SZI_(G),SZJ_(G)) :: work_2d ! The rate of change of column-integrated tracer + ! content [Conc H T-1 ~> Conc m s-1 or Conc kg m-2 s-1] + logical :: PCM(GV%ke) ! If true, do PCM remapping from a cell. + real :: Idt ! The inverse of the timestep [T-1 ~> s-1] + real :: u_src(GV%ke) ! A column of u-velocities on the source grid [L T-1 ~> m s-1] + real :: u_tgt(GV%ke) ! A column of u-velocities on the target grid [L T-1 ~> m s-1] + real :: v_src(GV%ke) ! A column of v-velocities on the source grid [L T-1 ~> m s-1] + real :: v_tgt(GV%ke) ! A column of v-velocities on the target grid [L T-1 ~> m s-1] + real :: h1(GV%ke) ! A column of source grid layer thicknesses [H ~> m or kg m-2] + real :: h2(GV%ke) ! A column of target grid layer thicknesses [H ~> m or kg m-2] real :: h_neglect, h_neglect_edge ! Tiny thicknesses used in remapping [H ~> m or kg m-2] - logical :: show_call_tree - type(tracer_type), pointer :: Tr => NULL() + logical :: show_call_tree + type(tracer_type), pointer :: Tr => NULL() integer :: i, j, k, m, nz, ntr show_call_tree = .false. if (present(debug)) show_call_tree = debug - if (show_call_tree) call callTree_enter("remap_all_state_vars(), MOM_ALE.F90") ! If remap_uv_using_old_alg is .true. and u or v is requested, then we must have dzInterface. Otherwise, ! u and v can be remapped without dzInterface - if ( .not. present(dzInterface) .and. (CS_ALE%remap_uv_using_old_alg .and. (present(u) .or. present(v))) ) then + if ( .not. present(dzInterface) .and. (CS%remap_uv_using_old_alg .and. (present(u) .or. present(v))) ) then call MOM_error(FATAL, "remap_all_state_vars: dzInterface must be present if using old algorithm "// & "and u/v are to be remapped") endif - if (.not.CS_ALE%answers_2018) then + if (.not.CS%answers_2018) then h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff elseif (GV%Boussinesq) then h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 @@ -794,7 +839,9 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, h_neglect = GV%kg_m2_to_H*1.0e-30 ; h_neglect_edge = GV%kg_m2_to_H*1.0e-10 endif - nz = GV%ke + if (show_call_tree) call callTree_enter("remap_all_state_vars(), MOM_ALE.F90") + + nz = GV%ke ntr = 0 ; if (associated(Reg)) ntr = Reg%ntr @@ -804,43 +851,43 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, work_cont(:,:,:) = 0.0 endif - ! Remap tracer + ! Remap all registered tracers, including temperature and salinity. if (ntr>0) then if (show_call_tree) call callTree_waypoint("remapping tracers (remap_all_state_vars)") - !$OMP parallel do default(shared) private(h1,h2,u_column,Tr) + !$OMP parallel do default(shared) private(h1,h2,tr_column,Tr,PCM,work_conc,work_cont,work_2d) do m=1,ntr ! For each tracer Tr => Reg%Tr(m) do j = G%jsc,G%jec ; do i = G%isc,G%iec ; if (G%mask2dT(i,j)>0.) then ! Build the start and final grids h1(:) = h_old(i,j,:) h2(:) = h_new(i,j,:) - call remapping_core_h(CS_remapping, nz, h1, Tr%t(i,j,:), nz, h2, & - u_column, h_neglect, h_neglect_edge) + call remapping_core_h(CS%remapCS, nz, h1, Tr%t(i,j,:), nz, h2, tr_column, & + h_neglect, h_neglect_edge) ! Intermediate steps for tendency of tracer concentration and tracer content. if (present(dt)) then if (Tr%id_remap_conc > 0) then do k=1,GV%ke - work_conc(i,j,k) = (u_column(k) - Tr%t(i,j,k)) * Idt + work_conc(i,j,k) = (tr_column(k) - Tr%t(i,j,k)) * Idt enddo endif if (Tr%id_remap_cont > 0 .or. Tr%id_remap_cont_2d > 0) then do k=1,GV%ke - work_cont(i,j,k) = (u_column(k)*h2(k) - Tr%t(i,j,k)*h1(k)) * Idt + work_cont(i,j,k) = (tr_column(k)*h2(k) - Tr%t(i,j,k)*h1(k)) * Idt enddo endif endif ! update tracer concentration - Tr%t(i,j,:) = u_column(:) + Tr%t(i,j,:) = tr_column(:) endif ; enddo ; enddo ! tendency diagnostics. if (present(dt)) then if (Tr%id_remap_conc > 0) then - call post_data(Tr%id_remap_conc, work_conc, CS_ALE%diag) + call post_data(Tr%id_remap_conc, work_conc, CS%diag) endif if (Tr%id_remap_cont > 0) then - call post_data(Tr%id_remap_cont, work_cont, CS_ALE%diag) + call post_data(Tr%id_remap_cont, work_cont, CS%diag) endif if (Tr%id_remap_cont_2d > 0) then do j = G%jsc,G%jec ; do i = G%isc,G%iec @@ -849,43 +896,65 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, work_2d(i,j) = work_2d(i,j) + work_cont(i,j,k) enddo enddo ; enddo - call post_data(Tr%id_remap_cont_2d, work_2d, CS_ALE%diag) + call post_data(Tr%id_remap_cont_2d, work_2d, CS%diag) endif endif enddo ! m=1,ntr - endif ! endif for ntr > 0 + endif ! endif for ntr > 0 if (show_call_tree) call callTree_waypoint("tracers remapped (remap_all_state_vars)") + if (CS%partial_cell_vel_remap .and. (present(u) .or. present(v)) ) then + h_tot(:,:) = 0.0 + do k=1,GV%ke ; do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 + h_tot(i,j) = h_tot(i,j) + h_old(i,j,k) + enddo ; enddo ; enddo + endif + ! Remap u velocity component if ( present(u) ) then - !$OMP parallel do default(shared) private(h1,h2,dz,u_column) - do j = G%jsc,G%jec ; do I = G%iscB,G%iecB ; if (G%mask2dCu(I,j)>0.) then + + !$OMP parallel do default(shared) private(h1,h2,dz,u_src,h_mask_vel,u_tgt) + do j=G%jsc,G%jec ; do I=G%IscB,G%IecB ; if (G%mask2dCu(I,j)>0.) then ! Build the start and final grids - h1(:) = 0.5 * ( h_old(i,j,:) + h_old(i+1,j,:) ) - if (CS_ALE%remap_uv_using_old_alg) then + do k=1,nz + u_src(k) = u(I,j,k) + h1(k) = 0.5*(h_old(i,j,k) + h_old(i+1,j,k)) + h2(k) = 0.5*(h_new(i,j,k) + h_new(i+1,j,k)) + enddo + if (CS%remap_uv_using_old_alg) then dz(:) = 0.5 * ( dzInterface(i,j,:) + dzInterface(i+1,j,:) ) do k = 1, nz h2(k) = max( 0., h1(k) + ( dz(k) - dz(k+1) ) ) enddo - else - h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i+1,j,:) ) endif - if (associated(OBC)) then - if (OBC%segnum_u(I,j) /= 0) then - if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - h1(:) = h_old(i,j,:) - h2(:) = h_new(i,j,:) - else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) - h1(:) = h_old(i+1,j,:) - h2(:) = h_new(i+1,j,:) - endif + + if (CS%partial_cell_vel_remap) then + h_mask_vel = min(h_tot(i,j), h_tot(i+1,j)) + call apply_partial_cell_mask(h1, h_mask_vel) + call apply_partial_cell_mask(h2, h_mask_vel) + endif + + if (associated(OBC)) then ; if (OBC%segnum_u(I,j) /= 0) then + if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then + do k=1,nz ; h1(k) = h_old(i,j,k) ; h2(k) = h_new(i,j,k) ; enddo + else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) + do k=1,nz ; h1(k) = h_old(i+1,j,k) ; h2(k) = h_new(i+1,j,k) ; enddo endif + endif ; endif + + ! --- Remap u profiles from the source vertical grid onto the new target grid. + call remapping_core_h(CS%vel_remapCS, nz, h1, u_src, nz, h2, u_tgt, & + h_neglect, h_neglect_edge) + + if ((CS%BBL_h_vel_mask > 0.0) .and. (CS%h_vel_mask > 0.0)) then + call mask_near_bottom_vel(u_tgt, h2, CS%BBL_h_vel_mask, CS%h_vel_mask, nz) endif - call remapping_core_h(CS_remapping, nz, h1, u(I,j,:), nz, h2, & - u_column, h_neglect, h_neglect_edge) - u(I,j,:) = u_column(:) + + do k=1,nz + u(I,j,k) = u_tgt(k) + enddo !k endif ; enddo ; enddo endif @@ -893,41 +962,53 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, ! Remap v velocity component if ( present(v) ) then - !$OMP parallel do default(shared) private(h1,h2,dz,u_column) - do J = G%jscB,G%jecB ; do i = G%isc,G%iec ; if (G%mask2dCv(i,j)>0.) then + !$OMP parallel do default(shared) private(h1,h2,v_src,dz,h_mask_vel,v_tgt) + do J=G%JscB,G%JecB ; do i=G%isc,G%iec ; if (G%mask2dCv(i,J)>0.) then ! Build the start and final grids - h1(:) = 0.5 * ( h_old(i,j,:) + h_old(i,j+1,:) ) - if (CS_ALE%remap_uv_using_old_alg) then + do k=1,nz + v_src(k) = v(i,J,k) + h1(k) = 0.5*(h_old(i,j,k) + h_old(i,j+1,k)) + h2(k) = 0.5*(h_new(i,j,k) + h_new(i,j+1,k)) + enddo + if (CS%remap_uv_using_old_alg) then dz(:) = 0.5 * ( dzInterface(i,j,:) + dzInterface(i,j+1,:) ) do k = 1, nz h2(k) = max( 0., h1(k) + ( dz(k) - dz(k+1) ) ) enddo - else - h2(:) = 0.5 * ( h_new(i,j,:) + h_new(i,j+1,:) ) endif - if (associated(OBC)) then - if (OBC%segnum_v(i,J) /= 0) then - if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - h1(:) = h_old(i,j,:) - h2(:) = h_new(i,j,:) - else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) - h1(:) = h_old(i,j+1,:) - h2(:) = h_new(i,j+1,:) - endif + if (CS%partial_cell_vel_remap) then + h_mask_vel = min(h_tot(i,j), h_tot(i,j+1)) + call apply_partial_cell_mask(h1, h_mask_vel) + call apply_partial_cell_mask(h2, h_mask_vel) + endif + if (associated(OBC)) then ; if (OBC%segnum_v(i,J) /= 0) then + if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then + do k=1,nz ; h1(k) = h_old(i,j,k) ; h2(k) = h_new(i,j,k) ; enddo + else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) + do k=1,nz ; h1(k) = h_old(i,j+1,k) ; h2(k) = h_new(i,j+1,k) ; enddo endif + endif ; endif + + ! --- Remap v profiles from the source vertical grid onto the new target grid. + call remapping_core_h(CS%vel_remapCS, nz, h1, v_src, nz, h2, v_tgt, & + h_neglect, h_neglect_edge) + + if ((CS%BBL_h_vel_mask > 0.0) .and. (CS%h_vel_mask > 0.0)) then + call mask_near_bottom_vel(v_tgt, h2, CS%BBL_h_vel_mask, CS%h_vel_mask, nz) endif - call remapping_core_h(CS_remapping, nz, h1, v(i,J,:), nz, h2, & - u_column, h_neglect, h_neglect_edge) - v(i,J,:) = u_column(:) + + do k=1,nz + v(i,J,k) = v_tgt(k) + enddo !k endif ; enddo ; enddo endif - if (CS_ALE%id_vert_remap_h > 0) call post_data(CS_ALE%id_vert_remap_h, h_old, CS_ALE%diag) - if ((CS_ALE%id_vert_remap_h_tendency > 0) .and. present(dt)) then + if (CS%id_vert_remap_h > 0) call post_data(CS%id_vert_remap_h, h_old, CS%diag) + if ((CS%id_vert_remap_h_tendency > 0) .and. present(dt)) then do k = 1, nz ; do j = G%jsc,G%jec ; do i = G%isc,G%iec work_cont(i,j,k) = (h_new(i,j,k) - h_old(i,j,k))*Idt enddo ; enddo ; enddo - call post_data(CS_ALE%id_vert_remap_h_tendency, work_cont, CS_ALE%diag) + call post_data(CS%id_vert_remap_h_tendency, work_cont, CS%diag) endif if (show_call_tree) call callTree_waypoint("v remapped (remap_all_state_vars)") if (show_call_tree) call callTree_leave("remap_all_state_vars()") @@ -935,6 +1016,55 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, end subroutine remap_all_state_vars +!> Mask out thicknesses to 0 when their runing sum exceeds a specified value. +subroutine apply_partial_cell_mask(h1, h_mask) + real, dimension(:), intent(inout) :: h1 !< A column of thicknesses to be masked out after their + !! running vertical sum exceeds h_mask [H ~> m or kg m-2] + real, intent(in) :: h_mask !< The depth after which the thicknesses in h1 are + !! masked out [H ~> m or kg m-2] + ! Local variables + real :: h1_rsum ! The running sum of h1 [H ~> m or kg m-2] + integer :: k + + h1_rsum = 0.0 + do k=1,size(h1) + if (h1(k) > h_mask - h1_rsum) then + ! This thickness is reduced because it extends below the shallower neighboring bathymetry. + h1(k) = max(h_mask - h1_rsum, 0.0) + h1_rsum = h_mask + else + h1_rsum = h1_rsum + h1(k) + endif + enddo +end subroutine apply_partial_cell_mask + + +!> Zero out velocities in a column in very thin layers near the seafloor +subroutine mask_near_bottom_vel(vel, h, h_BBL, h_thin, nk) + integer, intent(in) :: nk !< The number of layers in this column + real, intent(inout) :: vel(nk) !< The velocity component being zeroed out [L T-1 ~> m s-1] + real, intent(in) :: h(nk) !< The layer thicknesses at velocity points [H ~> m or kg m-2] + real, intent(in) :: h_BBL !< The thickness of the near-bottom region over which to apply + !! the filtering [H ~> m or kg m-2] + real, intent(in) :: h_thin !< A layer thickness below which the filtering is applied [H ~> m or kg m-2] + + ! Local variables + real :: h_from_bot ! The distance between the top of a layer and the seafloor [H ~> m or kg m-2] + integer :: k + + if ((h_BBL < 0.0) .or. (h_thin < 0.0)) return + + h_from_bot = 0.0 + do k=nk,1,-1 + h_from_bot = h_from_bot + h(k) + if (h_from_bot > h_BBL) return + ! Set the velocity to zero in thin, near-bottom layers. + if (h(k) <= h_thin) vel(k) = 0.0 + enddo !k + +end subroutine mask_near_bottom_vel + + !> Remaps a single scalar between grids described by thicknesses h_src and h_dst. !! h_dst must be dimensioned as a model array with GV%ke layers while h_src can !! have an arbitrary number of layers specified by nk_src. From 464046138500854a95a0e7f89ac1677e71c8462a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 24 Feb 2022 13:51:55 -0500 Subject: [PATCH 69/73] (*)Avoid negative thicknesses in mixed_layer_restrat Enforce a minimum thickness of 0.5*Angstrom in the mixed_layer_restrat routines. The streamfunctions in these routines attempt to limit the thicknesses to exceed Angstrom, but they can be less than this due to roundoff. The new limit prevents thicknesses from becoming negative when Angstrom is set to 0, but should not change any answers for test cases with positive values of Angstrom. Also added some comments describing variables and their units and simplified the OMP directives. Also corrected error messages in MOM_diabatic_aux.F90 to identify the file or module where these messages come from, and modified an error message in applyTracerBoundaryFluxesInOut so that it is written if the localized fault does not happen to occur on the root PE. All answers in the existing MOM6-examples regression suite are bitwise identical. --- .../lateral/MOM_mixed_layer_restrat.F90 | 85 ++++++++++--------- .../vertical/MOM_diabatic_aux.F90 | 12 +-- src/tracer/MOM_tracer_diabatic.F90 | 2 +- 3 files changed, 50 insertions(+), 49 deletions(-) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 04982d7171..6176f4aa1d 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -156,15 +156,16 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real :: u_star ! surface friction velocity, interpolated to velocity points [Z T-1 ~> m s-1]. real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1] real :: timescale ! mixing growth timescale [T ~> s] + real :: h_min ! The minimum layer thickness [H ~> m or kg m-2]. h_min could be 0. real :: h_neglect ! tiny thickness usually lost in roundoff so can be neglected [H ~> m or kg m-2] real :: dz_neglect ! A tiny thickness that is usually lost in roundoff so can be neglected [Z ~> m] real :: I4dt ! 1/(4 dt) [T-1 ~> s-1] real :: Ihtot,Ihtot_slow! Inverses of the total mixed layer thickness [H-1 ~> m-1 or m2 kg-1] real :: a(SZK_(GV)) ! A non-dimensional value relating the overall flux ! magnitudes (uDml & vDml) to the realized flux in a - ! layer. The vertical sum of a() through the pieces of + ! layer [nondim]. The vertical sum of a() through the pieces of ! the mixed layer must be 0. - real :: b(SZK_(GV)) ! As for a(k) but for the slow-filtered MLD + real :: b(SZK_(GV)) ! As for a(k) but for the slow-filtered MLD [nondim] real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper real :: vDml(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. real :: uDml_slow(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper @@ -172,21 +173,25 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! restratification timescales in the zonal and real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! meridional directions [T ~> s], stored in 2-D arrays ! for diagnostic purposes. - real :: uDml_diag(SZIB_(G),SZJ_(G)), vDml_diag(SZI_(G),SZJB_(G)) + real :: uDml_diag(SZIB_(G),SZJ_(G)) ! A 2D copy of uDml for diagnostics [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vDml_diag(SZI_(G),SZJB_(G)) ! A 2D copy of vDml for diagnostics [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G)) :: rhoSurf, deltaRhoAtKm1, deltaRhoAtK ! Densities [R ~> kg m-3] real, dimension(SZI_(G)) :: dK, dKm1 ! Depths of layer centers [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: pRef_MLD ! A reference pressure for calculating the mixed layer ! densities [R L2 T-2 ~> Pa]. - real, dimension(SZI_(G)) :: rhoAtK, rho1, d1, pRef_N2 ! Used for N2 - real :: aFac, bFac ! Nondimensional ratios [nondim] - real :: ddRho ! A density difference [R ~> kg m-3] - real :: hAtVel, zpa, zpb, dh, res_scaling_fac + real :: aFac, bFac ! Nondimensional ratios [nondim] + real :: ddRho ! A density difference [R ~> kg m-3] + real :: hAtVel ! Thickness at the velocity points [H ~> m or kg m-2] + real :: zpa ! Fractional position within the mixed layer of the interface above a layer [nondim] + real :: zpb ! Fractional position within the mixed layer of the interface below a layer [nondim] + real :: dh ! Portion of the layer thickness that is in the mixed layer [H ~> m or kg m-2] + real :: res_scaling_fac ! The resolution-dependent scaling factor [nondim] real :: I_LFront ! The inverse of the frontal length scale [L-1 ~> m-1] logical :: line_is_empty, keep_going, res_upscale integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz - real :: PSI, PSI1, z, BOTTOP, XP, DD ! For the following statement functions + real :: PSI, PSI1, z, BOTTOP, XP, DD ! For the following statement functions [nondim] ! Stream function as a function of non-dimensional position within mixed-layer (F77 statement function) !PSI1(z) = max(0., (1. - (2.*z+1.)**2 ) ) PSI1(z) = max(0., (1. - (2.*z+1.)**2 ) * (1. + (5./21.)*(2.*z+1.)**2) ) @@ -198,6 +203,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + h_min = 0.5*GV%Angstrom_H ! This should be GV%Angstrom_H, but that value would change answers. + if (.not.associated(tv%eqn_of_state)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "An equation of state must be used with this module.") if (.not. allocated(VarMix%Rd_dx_h) .and. CS%front_length > 0.) & @@ -299,16 +306,11 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var p0(:) = 0.0 EOSdom(:) = EOS_domain(G%HI, halo=1) -!$OMP parallel default(none) shared(is,ie,js,je,G,GV,US,htot_fast,Rml_av_fast,tv,p0,h,h_avail,& -!$OMP h_neglect,g_Rho0,I4dt,CS,uhml,uhtr,dt,vhml,vhtr,EOSdom, & -!$OMP utimescale_diag,vtimescale_diag,forces,dz_neglect, & -!$OMP htot_slow,MLD_slow,Rml_av_slow,VarMix,I_LFront, & -!$OMP res_upscale, nz,MLD_fast,uDml_diag,vDml_diag) & -!$OMP private(rho_ml,h_vel,u_star,absf,mom_mixrate,timescale, & -!$OMP line_is_empty, keep_going,res_scaling_fac, & -!$OMP a,IhTot,b,Ihtot_slow,zpb,hAtVel,zpa,dh) & -!$OMP firstprivate(uDml,vDml,uDml_slow,vDml_slow) -!$OMP do + !$OMP parallel default(shared) private(rho_ml,h_vel,u_star,absf,mom_mixrate,timescale, & + !$OMP line_is_empty, keep_going,res_scaling_fac, & + !$OMP a,IhTot,b,Ihtot_slow,zpb,hAtVel,zpa,dh) & + !$OMP firstprivate(uDml,vDml,uDml_slow,vDml_slow) + !$OMP do do j=js-1,je+1 do i=is-1,ie+1 htot_fast(i,j) = 0.0 ; Rml_av_fast(i,j) = 0.0 @@ -359,7 +361,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! 2. Add exponential tail to stream-function? ! U - Component -!$OMP do + !$OMP do do j=js,je ; do I=is-1,ie u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) @@ -435,7 +437,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo ; enddo ! V- component -!$OMP do + !$OMP do do J=js-1,je ; do i=is,ie u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) @@ -510,12 +512,13 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var vDml_diag(i,J) = vDml(i) enddo ; enddo -!$OMP do + !$OMP do do j=js,je ; do k=1,nz ; do i=is,ie h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * & ((uhml(I,j,k) - uhml(I-1,j,k)) + (vhml(i,J,k) - vhml(i,J-1,k))) + if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo -!$OMP end parallel + !$OMP end parallel ! Whenever thickness changes let the diag manager know, target grids ! for vertical remapping may need to be regenerated. @@ -590,23 +593,23 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) real :: u_star ! surface friction velocity, interpolated to velocity points [Z T-1 ~> m s-1]. real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1] real :: timescale ! mixing growth timescale [T ~> s] + real :: h_min ! The minimum layer thickness [H ~> m or kg m-2]. h_min could be 0. real :: h_neglect ! tiny thickness usually lost in roundoff and can be neglected [H ~> m or kg m-2] real :: dz_neglect ! tiny thickness that usually lost in roundoff and can be neglected [Z ~> m] real :: I4dt ! 1/(4 dt) [T-1 ~> s-1] real :: I2htot ! Twice the total mixed layer thickness at velocity points [H ~> m or kg m-2] real :: z_topx2 ! depth of the top of a layer at velocity points [H ~> m or kg m-2] real :: hx2 ! layer thickness at velocity points [H ~> m or kg m-2] - real :: a(SZK_(GV)) ! A non-dimensional value relating the overall flux - ! magnitudes (uDml & vDml) to the realized flux in a - ! layer. The vertical sum of a() through the pieces of - ! the mixed layer must be 0. + real :: a(SZK_(GV)) ! A non-dimensional value relating the overall flux magnitudes (uDml & vDml) + ! to the realized flux in a layer [nondim]. The vertical sum of a() + ! through the pieces of the mixed layer must be 0. real :: uDml(SZIB_(G)) ! The zonal and meridional volume fluxes in the upper real :: vDml(SZI_(G)) ! half of the mixed layer [H L2 T-1 ~> m3 s-1 or kg s-1]. - real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! The restratification timescales - real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! in the zonal and meridional - ! directions [T ~> s], stored in 2-D + real :: utimescale_diag(SZIB_(G),SZJ_(G)) ! The restratification timescales in the zonal and + real :: vtimescale_diag(SZI_(G),SZJB_(G)) ! meridional directions [T ~> s], stored in 2-D ! arrays for diagnostic purposes. - real :: uDml_diag(SZIB_(G),SZJ_(G)), vDml_diag(SZI_(G),SZJB_(G)) + real :: uDml_diag(SZIB_(G),SZJ_(G)) ! A 2D copy of uDml for diagnostics [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: vDml_diag(SZI_(G),SZJB_(G)) ! A 2D copy of vDml for diagnostics [H L2 T-1 ~> m3 s-1 or kg s-1] logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state @@ -619,6 +622,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) if ((nkml<2) .or. (CS%ml_restrat_coef<=0.0)) return + h_min = 0.5*GV%Angstrom_H ! This should be GV%Angstrom_H, but that value would change answers. uDml(:) = 0.0 ; vDml(:) = 0.0 I4dt = 0.25 / dt g_Rho0 = GV%g_Earth / GV%Rho0 @@ -633,14 +637,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) p0(:) = 0.0 EOSdom(:) = EOS_domain(G%HI, halo=1) -!$OMP parallel default(none) shared(is,ie,js,je,G,GV,US,htot,Rml_av,tv,p0,h,h_avail,EOSdom, & -!$OMP h_neglect,g_Rho0,I4dt,CS,uhml,uhtr,dt,vhml,vhtr, & -!$OMP utimescale_diag,vtimescale_diag,forces,dz_neglect, & -!$OMP uDml_diag,vDml_diag,nkml) & -!$OMP private(Rho0,h_vel,u_star,absf,mom_mixrate,timescale, & -!$OMP I2htot,z_topx2,hx2,a) & -!$OMP firstprivate(uDml,vDml) -!$OMP do + !$OMP parallel default(shared) private(Rho0,h_vel,u_star,absf,mom_mixrate,timescale, & + !$OMP I2htot,z_topx2,hx2,a) & + !$OMP firstprivate(uDml,vDml) + !$OMP do do j=js-1,je+1 do i=is-1,ie+1 htot(i,j) = 0.0 ; Rml_av(i,j) = 0.0 @@ -664,7 +664,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) ! 2. Add exponential tail to stream-function? ! U - Component -!$OMP do + !$OMP do do j=js,je ; do I=is-1,ie h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z @@ -711,7 +711,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) enddo ; enddo ! V- component -!$OMP do + !$OMP do do J=js-1,je ; do i=is,ie h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z @@ -756,12 +756,13 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) vDml_diag(i,J) = vDml(i) enddo ; enddo -!$OMP do + !$OMP do do j=js,je ; do k=1,nkml ; do i=is,ie h(i,j,k) = h(i,j,k) - dt*G%IareaT(i,j) * & ((uhml(I,j,k) - uhml(I-1,j,k)) + (vhml(i,J,k) - vhml(i,J-1,k))) + if (h(i,j,k) < h_min) h(i,j,k) = h_min enddo ; enddo ; enddo -!$OMP end parallel + !$OMP end parallel ! Whenever thickness changes let the diag manager know, target grids ! for vertical remapping may need to be regenerated. diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 13d25f06f5..6f1988c295 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -650,7 +650,7 @@ end subroutine set_pen_shortwave !> Diagnose a mixed layer depth (MLD) determined by a given density difference with the surface. -!> This routine is appropriate in MOM_diabatic_driver due to its position within the time stepping. +!> This routine is appropriate in MOM_diabatic_aux due to its position within the time stepping. subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, diagPtr, & id_N2subML, id_MLDsq, dz_subML) type(ocean_grid_type), intent(in) :: G !< Grid type @@ -781,7 +781,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, end subroutine diagnoseMLDbyDensityDifference !> Diagnose a mixed layer depth (MLD) determined by the depth a given energy value would mix. -!> This routine is appropriate in MOM_diabatic_driver due to its position within the time stepping. +!> This routine is appropriate in MOM_diabatic_aux due to its position within the time stepping. subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, diagPtr) ! Author: Brandon Reichl ! Date: October 2, 2020 @@ -1377,7 +1377,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t write(0,*) 'applyBoundaryFluxesInOut(): netT,netS,netH=',netHeat(i),netSalt(i),netMassInOut(i) write(0,*) 'applyBoundaryFluxesInOut(): dT,dS,dH=',dTemp,dSalt,dThickness write(0,*) 'applyBoundaryFluxesInOut(): h(n),h(n+1),k=',hOld,h2d(i,k),k - call MOM_error(FATAL, "MOM_diabatic_driver.F90, applyBoundaryFluxesInOut(): "//& + call MOM_error(FATAL, "MOM_diabatic_aux.F90, applyBoundaryFluxesInOut(): "//& "Complete mass loss in column!") endif @@ -1392,7 +1392,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t write(0,*) 'applyBoundaryFluxesInOut(): netHeat,netSalt,netMassIn,netMassOut=',& netHeat(i),netSalt(i),netMassIn(i),netMassOut(i) - call MOM_error(FATAL, "MOM_diabatic_driver.F90, applyBoundaryFluxesInOut(): "//& + call MOM_error(FATAL, "MOM_diabatic_aux.F90, applyBoundaryFluxesInOut(): "//& "Mass loss over land?") endif @@ -1526,13 +1526,13 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t call forcing_SinglePointPrint(fluxes,G,iGround(i),jGround(i),'applyBoundaryFluxesInOut (grounding)') write(mesg(1:45),'(3es15.3)') G%geoLonT( iGround(i), jGround(i) ), & G%geoLatT( iGround(i), jGround(i)), hGrounding(i)*GV%H_to_m - call MOM_error(WARNING, "MOM_diabatic_driver.F90, applyBoundaryFluxesInOut(): "//& + call MOM_error(WARNING, "MOM_diabatic_aux.F90, applyBoundaryFluxesInOut(): "//& "Mass created. x,y,dh= "//trim(mesg), all_print=.true.) enddo if (numberOfGroundings - maxGroundings > 0) then write(mesg, '(i4)') numberOfGroundings - maxGroundings - call MOM_error(WARNING, "MOM_diabatic_driver:F90, applyBoundaryFluxesInOut(): "//& + call MOM_error(WARNING, "MOM_diabatic_aux:F90, applyBoundaryFluxesInOut(): "//& trim(mesg) // " groundings remaining") endif endif diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index c865e645ad..66adfb3695 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -635,7 +635,7 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim if (numberOfGroundings - maxGroundings > 0) then write(mesg, '(i4)') numberOfGroundings - maxGroundings call MOM_error(WARNING, "MOM_tracer_vertical.F90, applyTracerBoundaryFluxesInOut(): "//& - trim(mesg) // " groundings remaining") + trim(mesg) // " groundings remaining", all_print=.true.) endif endif From dadd18251317247b4d371dbabd694ac6feb16f7f Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Mon, 29 Nov 2021 09:51:21 -0500 Subject: [PATCH 70/73] add infrastructure for residual term --- .../lateral/MOM_internal_tides.F90 | 79 +++++++++++++++++-- 1 file changed, 74 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index dfbb3e0d63..19ca933ab5 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -65,6 +65,10 @@ module MOM_internal_tides !< identifies reflection cells where double reflection !! is possible (i.e. ridge cells) ! (could be in G control structure) + real, allocatable, dimension(:,:) :: trans + !< partial transmission coeff for each "coast cell" + real, allocatable, dimension(:,:) :: residual + !< residual of reflection and transmission coeff for each "coast cell" real, allocatable, dimension(:,:,:,:) :: cp !< horizontal phase speed [L T-1 ~> m s-1] real, allocatable, dimension(:,:,:,:,:) :: TKE_leak_loss @@ -79,6 +83,8 @@ module MOM_internal_tides !! the energy losses in [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_itidal_loss !< energy lost due to small-scale wave drag [R Z3 T-3 ~> W m-2] + real, allocatable, dimension(:,:,:,:,:) :: TKE_residual_loss + real, allocatable, dimension(:,:) :: tot_leak_loss !< Energy loss rates due to misc bakground processes, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_quad_loss !< Energy loss rates due to quadratic bottom drag, @@ -87,6 +93,8 @@ module MOM_internal_tides !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_Froude_loss !< Energy loss rates due to wave breaking, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] + real, allocatable, dimension(:,:) :: tot_residual_loss !< Energy loss rates due to wave breaking, + real, allocatable, dimension(:,:) :: tot_allprocesses_loss !< Energy loss rates due to all processes, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real :: q_itides !< fraction of local dissipation [nondim] @@ -107,6 +115,8 @@ module MOM_internal_tides !< If true, apply scattering due to small-scale roughness as a sink. logical :: apply_Froude_drag !< If true, apply wave breaking as a sink. + logical :: apply_residual_drag + !< If true, apply sink from residual term of reflection/transmission. real, allocatable :: En(:,:,:,:,:) !< The internal wave energy density as a function of (i,j,angle,frequency,mode) !! integrated within an angular and frequency band [R Z3 T-2 ~> J m-2] @@ -122,10 +132,11 @@ module MOM_internal_tides ! Diag handles relevant to all modes, frequencies, and angles integer :: id_tot_En = -1, id_TKE_itidal_input = -1, id_itide_drag = -1 integer :: id_refl_pref = -1, id_refl_ang = -1, id_land_mask = -1 + integer :: id_trans = -1, id_residual = -1 integer :: id_dx_Cv = -1, id_dy_Cu = -1 ! Diag handles considering: sums over all modes, frequencies, and angles integer :: id_tot_leak_loss = -1, id_tot_quad_loss = -1, id_tot_itidal_loss = -1 - integer :: id_tot_Froude_loss = -1, id_tot_allprocesses_loss = -1 + integer :: id_tot_Froude_loss = -1, id_tot_residual_loss = -1, id_tot_allprocesses_loss = -1 ! Diag handles considering: all modes & freqs; summed over angles integer, allocatable, dimension(:,:) :: & id_En_mode, & @@ -184,7 +195,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & flux_prec_y real, dimension(SZI_(G),SZJ_(G)) :: & tot_En, & ! energy summed over angles, modes, frequencies [R Z3 T-2 ~> J m-2] - tot_leak_loss, tot_quad_loss, tot_itidal_loss, tot_Froude_loss, tot_allprocesses_loss, & + tot_leak_loss, tot_quad_loss, tot_itidal_loss, tot_Froude_loss, tot_residual_loss, tot_allprocesses_loss, & ! energy loss rates summed over angle, freq, and mode [R Z3 T-3 ~> W m-2] htot, & ! The vertical sum of the layer thicknesses [H ~> m or kg m-2] drag_scale, & ! bottom drag scale [T-1 ~> s-1] @@ -502,6 +513,16 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & enddo ; enddo enddo ; enddo ; enddo + ! loss from residual of reflection/transmission coefficients + if (CS%apply_residual_drag) then + do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied + + CS%TKE_residual_loss(i,j,a,fr,m) = CS%En(i,j,a,fr,m) * CS%residual(i,j) * CS%decay_rate ! loss rate [R Z3 T-3 ~> W m-2] RD??? + CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + dt * CS%residual(i,j) * CS%decay_rate) ! implicit update + enddo ; enddo ; enddo ; enddo ; enddo + endif + + ! Check for energy conservation on computational domain.************************* do m=1,CS%NMode ; do fr=1,CS%Nfreq call sum_En(G,CS,CS%En(:,:,:,fr,m),'prop_int_tide') @@ -537,21 +558,25 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & tot_quad_loss(:,:) = 0.0 tot_itidal_loss(:,:) = 0.0 tot_Froude_loss(:,:) = 0.0 + tot_residual_loss(:,:) = 0.0 tot_allprocesses_loss(:,:) = 0.0 do m=1,CS%NMode ; do fr=1,CS%Nfreq ; do a=1,CS%nAngle ; do j=js,je ; do i=is,ie tot_leak_loss(i,j) = tot_leak_loss(i,j) + CS%TKE_leak_loss(i,j,a,fr,m) tot_quad_loss(i,j) = tot_quad_loss(i,j) + CS%TKE_quad_loss(i,j,a,fr,m) tot_itidal_loss(i,j) = tot_itidal_loss(i,j) + CS%TKE_itidal_loss(i,j,a,fr,m) tot_Froude_loss(i,j) = tot_Froude_loss(i,j) + CS%TKE_Froude_loss(i,j,a,fr,m) + tot_residual_loss(i,j) = tot_residual_loss(i,j) + CS%TKE_residual_loss(i,j,a,fr,m) enddo ; enddo ; enddo ; enddo ; enddo do j=js,je ; do i=is,ie tot_allprocesses_loss(i,j) = tot_leak_loss(i,j) + tot_quad_loss(i,j) + & - tot_itidal_loss(i,j) + tot_Froude_loss(i,j) + tot_itidal_loss(i,j) + tot_Froude_loss(i,j) + & + tot_residual_loss(i,j) enddo ; enddo CS%tot_leak_loss = tot_leak_loss CS%tot_quad_loss = tot_quad_loss CS%tot_itidal_loss = tot_itidal_loss CS%tot_Froude_loss = tot_Froude_loss + CS%tot_residual_loss = tot_residual_loss CS%tot_allprocesses_loss = tot_allprocesses_loss if (CS%id_tot_leak_loss > 0) then call post_data(CS%id_tot_leak_loss, tot_leak_loss, CS%diag) @@ -565,6 +590,9 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%id_tot_Froude_loss > 0) then call post_data(CS%id_tot_Froude_loss, tot_Froude_loss, CS%diag) endif + if (CS%id_tot_residual_loss > 0) then + call post_data(CS%id_tot_residual_loss, tot_residual_loss, CS%diag) + endif if (CS%id_tot_allprocesses_loss > 0) then call post_data(CS%id_tot_allprocesses_loss, tot_allprocesses_loss, CS%diag) endif @@ -578,7 +606,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & itidal_loss_mode(i,j) = itidal_loss_mode(i,j) + CS%TKE_itidal_loss(i,j,a,fr,m) allprocesses_loss_mode(i,j) = allprocesses_loss_mode(i,j) + & CS%TKE_leak_loss(i,j,a,fr,m) + CS%TKE_quad_loss(i,j,a,fr,m) + & - CS%TKE_itidal_loss(i,j,a,fr,m) + CS%TKE_Froude_loss(i,j,a,fr,m) + CS%TKE_itidal_loss(i,j,a,fr,m) + CS%TKE_Froude_loss(i,j,a,fr,m) + & + CS%TKE_residual_loss(i,j,a,fr,m) enddo ; enddo ; enddo call post_data(CS%id_itidal_loss_mode(fr,m), itidal_loss_mode, CS%diag) call post_data(CS%id_allprocesses_loss_mode(fr,m), allprocesses_loss_mode, CS%diag) @@ -2150,7 +2179,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) character(len=160) :: var_descript character(len=200) :: filename character(len=200) :: refl_angle_file, land_mask_file - character(len=200) :: refl_pref_file, refl_dbl_file + character(len=200) :: refl_pref_file, refl_dbl_file, trans_file character(len=200) :: dy_Cu_file, dx_Cv_file character(len=200) :: h2_file @@ -2269,6 +2298,9 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "INTERNAL_TIDE_WAVE_DRAG", CS%apply_wave_drag, & "If true, apply scattering due to small-scale roughness as a sink.", & default=.false.) + call get_param(param_file, mdl, "INTERNAL_TIDE_RESIDUAL_DRAG", CS%apply_residual_drag, & + "If true, TBD", & + default=.false.) call get_param(param_file, mdl, "INTERNAL_TIDE_DRAG_MIN_DEPTH", CS%drag_min_depth, & "The minimum total ocean thickness that will be used in the denominator "//& "of the quadratic drag terms for internal tides.", & @@ -2307,10 +2339,12 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%TKE_quad_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) allocate(CS%TKE_itidal_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) allocate(CS%TKE_Froude_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) + allocate(CS%TKE_residual_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) allocate(CS%tot_leak_loss(isd:ied,jsd:jed), source=0.0) allocate(CS%tot_quad_loss(isd:ied,jsd:jed), source=0.0) allocate(CS%tot_itidal_loss(isd:ied,jsd:jed), source=0.0) allocate(CS%tot_Froude_loss(isd:ied,jsd:jed), source=0.0) + allocate(CS%tot_residual_loss(isd:ied,jsd:jed), source=0.0) ! Compute the fixed part of the bottom drag loss from baroclinic modes call get_param(param_file, mdl, "H2_FILE", h2_file, & @@ -2406,6 +2440,32 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) else ; CS%refl_dbl(i,j) = .false. ; endif enddo ; enddo + ! Read in the transmission coefficient and infer the residual + call get_param(param_file, mdl, "TRANS_FILE", trans_file, & + "The path to the file containing the transmission coefficent for internal tides.", & + fail_if_missing=.false., default='') + filename = trim(CS%inputdir) // trim(trans_file) + allocate(CS%trans(isd:ied,jsd:jed), source=0.0) + if (file_exists(filename, G%domain)) then + call log_param(param_file, mdl, "INPUTDIR/TRANS_FILE", filename) + call MOM_read_data(filename, 'trans', CS%trans, G%domain) + else + if (trim(trans_file) /= '' ) call MOM_error(FATAL, & + "TRANS_FILE: "//trim(filename)//" not found") + endif + + call pass_var(CS%trans,G%domain) + ! residual + allocate(CS%residual(isd:ied,jsd:jed), source=0.0) + do j=jsd,jed + do i=isd,ied + if (CS%refl_pref_logical(i,j)) then + CS%residual(i,j) = 1. - CS%refl_pref(i,j) - CS%trans(i,j) + endif + enddo + enddo + call pass_var(CS%residual,G%domain) + ! Read in prescribed land mask from file (if overwriting -BDM). ! This should be done in MOM_initialize_topography subroutine ! defined in MOM_fixed_initialization.F90 (BDM) @@ -2445,6 +2505,10 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) Time, 'Local angle of coastline/ridge/shelf with respect to equator', 'rad') CS%id_refl_pref = register_diag_field('ocean_model', 'refl_pref', diag%axesT1, & Time, 'Partial reflection coefficients', '') + CS%id_trans = register_diag_field('ocean_model', 'trans', diag%axesT1, & + Time, 'Partial transmission coefficients', '') + CS%id_residual = register_diag_field('ocean_model', 'residual', diag%axesT1, & + Time, 'Residual of reflection and transmission coefficients', '') CS%id_dx_Cv = register_diag_field('ocean_model', 'dx_Cv', diag%axesT1, & Time, 'North face unblocked width', 'm', conversion=US%L_to_m) CS%id_dy_Cu = register_diag_field('ocean_model', 'dy_Cu', diag%axesT1, & @@ -2454,6 +2518,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) ! Output reflection parameters as diags here (not needed every timestep) if (CS%id_refl_ang > 0) call post_data(CS%id_refl_ang, CS%refl_angle, CS%diag) if (CS%id_refl_pref > 0) call post_data(CS%id_refl_pref, CS%refl_pref, CS%diag) + if (CS%id_trans > 0) call post_data(CS%id_trans, CS%trans, CS%diag) + if (CS%id_residual > 0) call post_data(CS%id_residual, CS%residual, CS%diag) if (CS%id_dx_Cv > 0) call post_data(CS%id_dx_Cv, G%dx_Cv, CS%diag) if (CS%id_dy_Cu > 0) call post_data(CS%id_dy_Cu, G%dy_Cu, CS%diag) if (CS%id_land_mask > 0) call post_data(CS%id_land_mask, G%mask2dT, CS%diag) @@ -2483,6 +2549,9 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) CS%id_tot_Froude_loss = register_diag_field('ocean_model', 'ITide_tot_Froude_loss', diag%axesT1, & Time, 'Internal tide energy loss to wave breaking', & 'W m-2', conversion=US%RZ3_T3_to_W_m2) + CS%id_tot_residual_loss = register_diag_field('ocean_model', 'ITide_tot_residual_loss', diag%axesT1, & + Time, 'Internal tide energy loss to residual on slopes', & + 'W m-2', conversion=US%RZ3_T3_to_W_m2) CS%id_tot_allprocesses_loss = register_diag_field('ocean_model', 'ITide_tot_allprocesses_loss', diag%axesT1, & Time, 'Internal tide energy loss summed over all processes', & 'W m-2', conversion=US%RZ3_T3_to_W_m2) From b671a87350dc0dd88c720ba281bc937b2bab3112 Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Wed, 8 Dec 2021 14:55:54 -0500 Subject: [PATCH 71/73] add residual term loss on flux --- .../lateral/MOM_internal_tides.F90 | 44 ++++++++++++++----- 1 file changed, 34 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 19ca933ab5..1cce1c0a29 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -84,6 +84,7 @@ module MOM_internal_tides real, allocatable, dimension(:,:,:,:,:) :: TKE_itidal_loss !< energy lost due to small-scale wave drag [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_residual_loss + real, allocatable, dimension(:,:,:,:,:) :: local_dissip real, allocatable, dimension(:,:) :: tot_leak_loss !< Energy loss rates due to misc bakground processes, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] @@ -297,8 +298,11 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Propagate the waves. do m=1,CS%NMode ; do fr=1,CS%Nfreq + + CS%local_dissip(:,:,:,fr,m) = 0. + call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt, & - G, US, CS, CS%NAngle) + G, US, CS, CS%NAngle, CS%local_dissip(:,:,:,fr,m)) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -515,10 +519,14 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! loss from residual of reflection/transmission coefficients if (CS%apply_residual_drag) then - do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied - CS%TKE_residual_loss(i,j,a,fr,m) = CS%En(i,j,a,fr,m) * CS%residual(i,j) * CS%decay_rate ! loss rate [R Z3 T-3 ~> W m-2] RD??? - CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + dt * CS%residual(i,j) * CS%decay_rate) ! implicit update + do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied + CS%TKE_residual_loss(i,j,a,fr,m) = CS%local_dissip(i,j,a,fr,m) !* CS%En(i,j,a,fr,m) + ! implicit + !CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + & + ! dt * CS%local_dissip(i,j,a,fr,m) / max(CS%En(i,j,a,fr,m), 1e-16)) + ! explicit works + CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) - dt * CS%local_dissip(i,j,a,fr,m) enddo ; enddo ; enddo ; enddo ; enddo endif @@ -1021,7 +1029,7 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) end subroutine PPM_angular_advect !> Propagates internal waves at a single frequency. -subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) +subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle, local_dissip) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1035,7 +1043,8 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) real, intent(in) :: dt !< Time step [T ~> s]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), intent(in) :: CS !< Internal tide control struct - + real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), & + intent(inout) :: local_dissip ! Local variables real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: & speed ! The magnitude of the group velocity at the q points for corner adv [L T-1 ~> m s-1]. @@ -1126,18 +1135,19 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle) ! Apply propagation in x-direction (reflection included) LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, CS%nAngle, CS, LB) + call propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, CS%nAngle, CS, LB, local_dissip) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G, CS, En, 'post-propagate_x') ! Update halos call pass_var(En, G%domain) + call pass_var(local_dissip, G%domain) ! Apply propagation in y-direction (reflection included) ! LB%jsh = js ; LB%jeh = je ; LB%ish = is ; LB%ieh = ie ! Use if no teleport LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, CS%nAngle, CS, LB) + call propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, CS%nAngle, CS, LB, local_dissip) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G, CS, En, 'post-propagate_y') @@ -1412,7 +1422,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS end subroutine propagate_corner_spread !> Propagates the internal wave energy in the logical x-direction. -subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) +subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, local_dissip) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1429,6 +1439,8 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. + real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), & + intent(inout) :: local_dissip ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & EnL, EnR ! Left and right face energy densities [R Z3 T-2 ~> J m-2]. @@ -1465,6 +1477,10 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) do j=jsh,jeh ; do i=ish,ieh Fdt_m(i,j,a) = dt*flux_x(I-1,j) ! left face influx [R Z3 L2 T-2 ~> J] Fdt_p(i,j,a) = -dt*flux_x(I,j) ! right face influx [R Z3 L2 T-2 ~> J] + + local_dissip(i,j,a) = local_dissip(i,j,a) + & + abs(flux_x(I-1,j)) * CS%residual(i,j) * G%IareaT(i,j) + & + abs(flux_x(I,j)) * CS%residual(i,j) * G%IareaT(i,j) enddo ; enddo enddo ! a-loop @@ -1486,7 +1502,7 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB) end subroutine propagate_x !> Propagates the internal wave energy in the logical y-direction. -subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) +subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB, local_dissip) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1503,6 +1519,8 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. + real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), & + intent(inout) :: local_dissip ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & EnL, EnR ! South and north face energy densities [R Z3 T-2 ~> J m-2]. @@ -1540,6 +1558,11 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB) do j=jsh,jeh ; do i=ish,ieh Fdt_m(i,j,a) = dt*flux_y(i,J-1) ! south face influx [R Z3 L2 T-2 ~> J] Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx [R Z3 L2 T-2 ~> J] + + local_dissip(i,j,a) = local_dissip(i,j,a) + & + abs(flux_y(i,J-1)) * CS%residual(i,j) * G%IareaT(i,j) + & + abs(flux_y(i,J)) * CS%residual(i,j) * G%IareaT(i,j) + !if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) then ! for debugging ! call MOM_error(WARNING, "propagate_y: OutFlux>Available prior to reflection", .true.) ! write(mesg,*) "flux_y_south=",flux_y(i,J-1),"flux_y_north=",flux_y(i,J),"En=",En(i,j,a), & @@ -2340,6 +2363,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%TKE_itidal_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) allocate(CS%TKE_Froude_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) allocate(CS%TKE_residual_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) + allocate(CS%local_dissip(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) allocate(CS%tot_leak_loss(isd:ied,jsd:jed), source=0.0) allocate(CS%tot_quad_loss(isd:ied,jsd:jed), source=0.0) allocate(CS%tot_itidal_loss(isd:ied,jsd:jed), source=0.0) From 46d292ce73f570b437da8e4a0337060ce0947512 Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Wed, 8 Dec 2021 16:25:34 -0500 Subject: [PATCH 72/73] clean up/ move to implicit update --- .../lateral/MOM_internal_tides.F90 | 50 ++++++++++--------- 1 file changed, 26 insertions(+), 24 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 1cce1c0a29..3d66a91828 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -84,8 +84,7 @@ module MOM_internal_tides real, allocatable, dimension(:,:,:,:,:) :: TKE_itidal_loss !< energy lost due to small-scale wave drag [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_residual_loss - real, allocatable, dimension(:,:,:,:,:) :: local_dissip - + !< internal tide energy loss due to the residual at slopes [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_leak_loss !< Energy loss rates due to misc bakground processes, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_quad_loss !< Energy loss rates due to quadratic bottom drag, @@ -94,8 +93,8 @@ module MOM_internal_tides !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_Froude_loss !< Energy loss rates due to wave breaking, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] - real, allocatable, dimension(:,:) :: tot_residual_loss !< Energy loss rates due to wave breaking, - + real, allocatable, dimension(:,:) :: tot_residual_loss !< Energy loss rates due to residual on slopes, + !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: tot_allprocesses_loss !< Energy loss rates due to all processes, !! summed over angle, frequency and mode [R Z3 T-3 ~> W m-2] real :: q_itides !< fraction of local dissipation [nondim] @@ -210,6 +209,7 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & real :: loss_rate ! An energy loss rate [T-1 ~> s-1] real :: Fr2_max real :: cn_subRO ! A tiny wave speed to prevent division by zero [L T-1 ~> m s-1] + real :: en_subRO ! A tiny energy to prevent division by zero [R Z3 T-2 ~> J m-2] real :: En_new, En_check ! Energies for debugging [R Z3 T-2 ~> J m-2] real :: En_initial, Delta_E_check ! Energies for debugging [R Z3 T-2 ~> J m-2] real :: TKE_Froude_loss_check, TKE_Froude_loss_tot ! Energy losses for debugging [R Z3 T-3 ~> W m-2] @@ -223,7 +223,8 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nAngle = CS%NAngle I_rho0 = 1.0 / GV%Rho0 - cn_subRO = 1e-100*US%m_s_to_L_T ! The hard-coded value here might need to increase. + cn_subRO = 1e-30*US%m_s_to_L_T ! The hard-coded value here might need to increase. + en_subRO = 1e-30*US%W_m2_to_RZ3_T3*US%s_to_T ! init local arrays drag_scale(:,:) = 0. @@ -299,10 +300,10 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & ! Propagate the waves. do m=1,CS%NMode ; do fr=1,CS%Nfreq - CS%local_dissip(:,:,:,fr,m) = 0. + CS%TKE_residual_loss(:,:,:,fr,m) = 0. call propagate(CS%En(:,:,:,fr,m), cn(:,:,m), CS%frequency(fr), dt, & - G, US, CS, CS%NAngle, CS%local_dissip(:,:,:,fr,m)) + G, US, CS, CS%NAngle, CS%TKE_residual_loss(:,:,:,fr,m)) enddo ; enddo ! Check for En<0 - for debugging, delete later @@ -521,12 +522,11 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & if (CS%apply_residual_drag) then do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied - CS%TKE_residual_loss(i,j,a,fr,m) = CS%local_dissip(i,j,a,fr,m) !* CS%En(i,j,a,fr,m) ! implicit - !CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + & - ! dt * CS%local_dissip(i,j,a,fr,m) / max(CS%En(i,j,a,fr,m), 1e-16)) - ! explicit works - CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) - dt * CS%local_dissip(i,j,a,fr,m) + CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + dt * CS%TKE_residual_loss(i,j,a,fr,m) / & + (CS%En(i,j,a,fr,m) + en_subRO)) + ! explicit + !CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) - dt * CS%TKE_residual_loss(i,j,a,fr,m) enddo ; enddo ; enddo ; enddo ; enddo endif @@ -1029,7 +1029,7 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) end subroutine PPM_angular_advect !> Propagates internal waves at a single frequency. -subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle, local_dissip) +subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle, residual_loss) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1044,7 +1044,8 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle, local_dissip) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(int_tide_CS), intent(in) :: CS !< Internal tide control struct real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), & - intent(inout) :: local_dissip + intent(inout) :: residual_loss !< internal tide energy loss due + !! to the residual at slopes [R Z3 T-3 ~> W m-2]. ! Local variables real, dimension(G%IsdB:G%IedB,G%JsdB:G%JedB) :: & speed ! The magnitude of the group velocity at the q points for corner adv [L T-1 ~> m s-1]. @@ -1135,19 +1136,19 @@ subroutine propagate(En, cn, freq, dt, G, US, CS, NAngle, local_dissip) ! Apply propagation in x-direction (reflection included) LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, CS%nAngle, CS, LB, local_dissip) + call propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, CS%nAngle, CS, LB, residual_loss) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G, CS, En, 'post-propagate_x') ! Update halos call pass_var(En, G%domain) - call pass_var(local_dissip, G%domain) + call pass_var(residual_loss, G%domain) ! Apply propagation in y-direction (reflection included) ! LB%jsh = js ; LB%jeh = je ; LB%ish = is ; LB%ieh = ie ! Use if no teleport LB%jsh = jsh ; LB%jeh = jeh ; LB%ish = ish ; LB%ieh = ieh - call propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, CS%nAngle, CS, LB, local_dissip) + call propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, CS%nAngle, CS, LB, residual_loss) ! Check for energy conservation on computational domain (for debugging) !call sum_En(G, CS, En, 'post-propagate_y') @@ -1422,7 +1423,7 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS end subroutine propagate_corner_spread !> Propagates the internal wave energy in the logical x-direction. -subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, local_dissip) +subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, residual_loss) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1440,7 +1441,8 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, loc type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), & - intent(inout) :: local_dissip + intent(inout) :: residual_loss !< internal tide energy loss due + !! to the residual at slopes [R Z3 T-3 ~> W m-2]. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & EnL, EnR ! Left and right face energy densities [R Z3 T-2 ~> J m-2]. @@ -1478,7 +1480,7 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, loc Fdt_m(i,j,a) = dt*flux_x(I-1,j) ! left face influx [R Z3 L2 T-2 ~> J] Fdt_p(i,j,a) = -dt*flux_x(I,j) ! right face influx [R Z3 L2 T-2 ~> J] - local_dissip(i,j,a) = local_dissip(i,j,a) + & + residual_loss(i,j,a) = residual_loss(i,j,a) + & abs(flux_x(I-1,j)) * CS%residual(i,j) * G%IareaT(i,j) + & abs(flux_x(I,j)) * CS%residual(i,j) * G%IareaT(i,j) enddo ; enddo @@ -1502,7 +1504,7 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, loc end subroutine propagate_x !> Propagates the internal wave energy in the logical y-direction. -subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB, local_dissip) +subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB, residual_loss) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle !< The number of wave orientations in the !! discretized wave energy spectrum. @@ -1520,7 +1522,8 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB, loc type(int_tide_CS), intent(in) :: CS !< Internal tide control struct type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), & - intent(inout) :: local_dissip + intent(inout) :: residual_loss !< internal tide energy loss due + !! to the residual at slopes [R Z3 T-3 ~> W m-2]. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & EnL, EnR ! South and north face energy densities [R Z3 T-2 ~> J m-2]. @@ -1559,7 +1562,7 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB, loc Fdt_m(i,j,a) = dt*flux_y(i,J-1) ! south face influx [R Z3 L2 T-2 ~> J] Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx [R Z3 L2 T-2 ~> J] - local_dissip(i,j,a) = local_dissip(i,j,a) + & + residual_loss(i,j,a) = residual_loss(i,j,a) + & abs(flux_y(i,J-1)) * CS%residual(i,j) * G%IareaT(i,j) + & abs(flux_y(i,J)) * CS%residual(i,j) * G%IareaT(i,j) @@ -2363,7 +2366,6 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) allocate(CS%TKE_itidal_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) allocate(CS%TKE_Froude_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) allocate(CS%TKE_residual_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) - allocate(CS%local_dissip(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) allocate(CS%tot_leak_loss(isd:ied,jsd:jed), source=0.0) allocate(CS%tot_quad_loss(isd:ied,jsd:jed), source=0.0) allocate(CS%tot_itidal_loss(isd:ied,jsd:jed), source=0.0) From 0120792291e732c8b44fcba75766df1fcff490a0 Mon Sep 17 00:00:00 2001 From: Raphael Dussin Date: Wed, 9 Mar 2022 11:19:32 -0500 Subject: [PATCH 73/73] parenthesis --- .../lateral/MOM_internal_tides.F90 | 27 ++++++++++--------- 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 3d66a91828..4d9a7e58bd 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -523,8 +523,11 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied ! implicit - CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + dt * CS%TKE_residual_loss(i,j,a,fr,m) / & - (CS%En(i,j,a,fr,m) + en_subRO)) + !CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) / (1.0 + dt * CS%TKE_residual_loss(i,j,a,fr,m) / & + ! (CS%En(i,j,a,fr,m) + en_subRO)) + CS%En(i,j,a,fr,m) = (CS%En(i,j,a,fr,m) * (CS%En(i,j,a,fr,m) + en_subRO)) / & + ((CS%En(i,j,a,fr,m) + en_subRO) + dt * CS%TKE_residual_loss(i,j,a,fr,m)) + ! explicit !CS%En(i,j,a,fr,m) = CS%En(i,j,a,fr,m) - dt * CS%TKE_residual_loss(i,j,a,fr,m) enddo ; enddo ; enddo ; enddo ; enddo @@ -576,9 +579,9 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & tot_residual_loss(i,j) = tot_residual_loss(i,j) + CS%TKE_residual_loss(i,j,a,fr,m) enddo ; enddo ; enddo ; enddo ; enddo do j=js,je ; do i=is,ie - tot_allprocesses_loss(i,j) = tot_leak_loss(i,j) + tot_quad_loss(i,j) + & - tot_itidal_loss(i,j) + tot_Froude_loss(i,j) + & - tot_residual_loss(i,j) + tot_allprocesses_loss(i,j) = ((((tot_leak_loss(i,j) + tot_quad_loss(i,j)) + & + tot_itidal_loss(i,j)) + tot_Froude_loss(i,j)) + & + tot_residual_loss(i,j)) enddo ; enddo CS%tot_leak_loss = tot_leak_loss CS%tot_quad_loss = tot_quad_loss @@ -613,9 +616,9 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & do a=1,CS%nAngle ; do j=js,je ; do i=is,ie itidal_loss_mode(i,j) = itidal_loss_mode(i,j) + CS%TKE_itidal_loss(i,j,a,fr,m) allprocesses_loss_mode(i,j) = allprocesses_loss_mode(i,j) + & - CS%TKE_leak_loss(i,j,a,fr,m) + CS%TKE_quad_loss(i,j,a,fr,m) + & - CS%TKE_itidal_loss(i,j,a,fr,m) + CS%TKE_Froude_loss(i,j,a,fr,m) + & - CS%TKE_residual_loss(i,j,a,fr,m) + ((((CS%TKE_leak_loss(i,j,a,fr,m) + CS%TKE_quad_loss(i,j,a,fr,m)) + & + CS%TKE_itidal_loss(i,j,a,fr,m)) + CS%TKE_Froude_loss(i,j,a,fr,m)) + & + CS%TKE_residual_loss(i,j,a,fr,m)) enddo ; enddo ; enddo call post_data(CS%id_itidal_loss_mode(fr,m), itidal_loss_mode, CS%diag) call post_data(CS%id_allprocesses_loss_mode(fr,m), allprocesses_loss_mode, CS%diag) @@ -1481,8 +1484,8 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, US, Nangle, CS, LB, res Fdt_p(i,j,a) = -dt*flux_x(I,j) ! right face influx [R Z3 L2 T-2 ~> J] residual_loss(i,j,a) = residual_loss(i,j,a) + & - abs(flux_x(I-1,j)) * CS%residual(i,j) * G%IareaT(i,j) + & - abs(flux_x(I,j)) * CS%residual(i,j) * G%IareaT(i,j) + (abs(flux_x(I-1,j)) * CS%residual(i,j) * G%IareaT(i,j) + & + abs(flux_x(I,j)) * CS%residual(i,j) * G%IareaT(i,j)) enddo ; enddo enddo ! a-loop @@ -1563,8 +1566,8 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, US, Nangle, CS, LB, res Fdt_p(i,j,a) = -dt*flux_y(i,J) ! north face influx [R Z3 L2 T-2 ~> J] residual_loss(i,j,a) = residual_loss(i,j,a) + & - abs(flux_y(i,J-1)) * CS%residual(i,j) * G%IareaT(i,j) + & - abs(flux_y(i,J)) * CS%residual(i,j) * G%IareaT(i,j) + (abs(flux_y(i,J-1)) * CS%residual(i,j) * G%IareaT(i,j) + & + abs(flux_y(i,J)) * CS%residual(i,j) * G%IareaT(i,j)) !if ((En(i,j,a) + G%IareaT(i,j)*(Fdt_m(i,j,a) + Fdt_p(i,j,a))) < 0.0) then ! for debugging ! call MOM_error(WARNING, "propagate_y: OutFlux>Available prior to reflection", .true.)