From 0a42b834c05ea357c6033622cf362185a4d51f01 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 13 Jun 2016 13:16:58 -0400 Subject: [PATCH 01/33] Moved ocean_OBC_type from MOM_variables to MOM_open_boundary - The ocean_OBC_type and OBC enumerated parameters (e.g. OBC_FLATHER_E) have been moved to MOM_open_boundary.F90 from MOM_variable.F90 in an attempt to consolidate code before refactoring and changing the way we control OBCs. - MOM_open_boundary.F90 seemed to only include Orkanski radiation code (used in baroclinic mode) and yet stored some of the radiation data in the ocean_OBS_type which is where all the Flather data and OBC masks is kept. - No answer changes. --- src/core/MOM.F90 | 3 +- src/core/MOM_barotropic.F90 | 6 +-- src/core/MOM_continuity.F90 | 3 +- src/core/MOM_continuity_PPM.F90 | 5 +- src/core/MOM_dynamics_legacy_split.F90 | 3 +- src/core/MOM_dynamics_split_RK2.F90 | 3 +- src/core/MOM_dynamics_unsplit.F90 | 3 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 3 +- src/core/MOM_legacy_barotropic.F90 | 6 +-- src/core/MOM_open_boundary.F90 | 54 ++++++++++++++++++- src/core/MOM_variables.F90 | 53 ------------------ .../MOM_state_initialization.F90 | 7 +-- .../lateral/MOM_hor_visc.F90 | 4 +- .../vertical/MOM_set_viscosity.F90 | 2 +- .../vertical/MOM_vert_friction.F90 | 3 +- src/tracer/DOME_tracer.F90 | 3 +- src/tracer/MOM_OCMIP2_CFC.F90 | 3 +- src/tracer/MOM_tracer_advect.F90 | 4 +- src/tracer/MOM_tracer_flow_control.F90 | 3 +- src/tracer/MOM_tracer_hor_diff.F90 | 5 +- src/tracer/advection_test_tracer.F90 | 3 +- src/tracer/dye_example.F90 | 3 +- src/tracer/ideal_age_example.F90 | 3 +- src/tracer/oil_tracer.F90 | 3 +- src/tracer/tracer_example.F90 | 3 +- src/user/DOME2d_initialization.F90 | 2 +- src/user/DOME_initialization.F90 | 3 +- src/user/ISOMIP_initialization.F90 | 2 +- src/user/Phillips_initialization.F90 | 4 +- src/user/Rossby_front_2d_initialization.F90 | 2 +- src/user/adjustment_initialization.F90 | 2 +- src/user/benchmark_initialization.F90 | 3 +- src/user/circle_obcs_initialization.F90 | 4 +- src/user/external_gwave_initialization.F90 | 2 +- src/user/lock_exchange_initialization.F90 | 2 +- src/user/seamount_initialization.F90 | 4 +- src/user/sloshing_initialization.F90 | 4 +- src/user/user_initialization.F90 | 5 +- 38 files changed, 122 insertions(+), 108 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 3afd5de7de..cc2f199989 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -3,7 +3,8 @@ module MOM ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_variables, only : vertvisc_type, ocean_OBC_type +use MOM_variables, only : vertvisc_type +use MOM_open_boundary, only : ocean_OBC_type ! A Structure with pointers to forcing fields to drive MOM; ! all fluxes are positive downward. diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 73a679bb65..61caee0b5b 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -105,13 +105,13 @@ module MOM_barotropic use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_io, only : vardesc, var_desc +use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE, OBC_NONE +use MOM_open_boundary, only : OBC_FLATHER_E, OBC_FLATHER_W +use MOM_open_boundary, only : OBC_FLATHER_N, OBC_FLATHER_S use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_tidal_forcing, only : tidal_forcing_sensitivity, tidal_forcing_CS use MOM_time_manager, only : time_type, set_time, operator(+), operator(-) use MOM_variables, only : BT_cont_type, alloc_bt_cont_type -use MOM_variables, only : ocean_OBC_type, OBC_SIMPLE, OBC_NONE -use MOM_variables, only : OBC_FLATHER_E, OBC_FLATHER_W -use MOM_variables, only : OBC_FLATHER_N, OBC_FLATHER_S use MOM_verticalGrid, only : verticalGrid_type implicit none ; private diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 99e58ebf1a..555484057d 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -47,7 +47,8 @@ module MOM_continuity use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_string_functions, only : uppercase use MOM_grid, only : ocean_grid_type -use MOM_variables, only : ocean_OBC_type, BT_cont_type +use MOM_open_boundary, only : ocean_OBC_type +use MOM_variables, only : BT_cont_type use MOM_verticalGrid, only : verticalGrid_type implicit none ; private diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index de0285c2a0..8a31121f1c 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -48,8 +48,9 @@ module MOM_continuity_PPM 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 -use MOM_variables, only : ocean_OBC_type, BT_cont_type, OBC_SIMPLE -use MOM_variables, only : OBC_FLATHER_E, OBC_FLATHER_W, OBC_FLATHER_N, OBC_FLATHER_S +use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE +use MOM_open_boundary, only : OBC_FLATHER_E, OBC_FLATHER_W, OBC_FLATHER_N, OBC_FLATHER_S +use MOM_variables, only : BT_cont_type use MOM_verticalGrid, only : verticalGrid_type implicit none ; private diff --git a/src/core/MOM_dynamics_legacy_split.F90 b/src/core/MOM_dynamics_legacy_split.F90 index 8fe4508b24..3ad5c3363c 100644 --- a/src/core/MOM_dynamics_legacy_split.F90 +++ b/src/core/MOM_dynamics_legacy_split.F90 @@ -66,7 +66,8 @@ module MOM_dynamics_legacy_split !********+*********+*********+*********+*********+*********+*********+** -use MOM_variables, only : vertvisc_type, ocean_OBC_type, thermo_var_ptrs +use MOM_open_boundary, only : ocean_OBC_type +use MOM_variables, only : vertvisc_type, thermo_var_ptrs use MOM_variables, only : BT_cont_type, alloc_bt_cont_type, dealloc_bt_cont_type use MOM_variables, only : accel_diag_ptrs, ocean_internal_state, cont_diag_ptrs use MOM_forcing_type, only : forcing diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 2e112bf274..b65ab8281c 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -3,7 +3,7 @@ module MOM_dynamics_split_RK2 ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_variables, only : vertvisc_type, ocean_OBC_type, thermo_var_ptrs +use MOM_variables, only : vertvisc_type, thermo_var_ptrs use MOM_variables, only : BT_cont_type, alloc_bt_cont_type, dealloc_bt_cont_type use MOM_variables, only : accel_diag_ptrs, ocean_internal_state, cont_diag_ptrs use MOM_forcing_type, only : forcing @@ -45,6 +45,7 @@ module MOM_dynamics_split_RK2 use MOM_interface_heights, only : find_eta use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type +use MOM_open_boundary, only : ocean_OBC_type use MOM_open_boundary, only : Radiation_Open_Bdry_Conds, open_boundary_init use MOM_open_boundary, only : open_boundary_CS use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 7b4a4d4960..6c50d2b80a 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -68,7 +68,7 @@ module MOM_dynamics_unsplit !********+*********+*********+*********+*********+*********+*********+** -use MOM_variables, only : vertvisc_type, ocean_OBC_type, thermo_var_ptrs +use MOM_variables, only : vertvisc_type, thermo_var_ptrs use MOM_variables, only : accel_diag_ptrs, ocean_internal_state, cont_diag_ptrs use MOM_forcing_type, only : forcing use MOM_checksum_packages, only : MOM_thermo_chksum, MOM_state_chksum, MOM_accel_chksum @@ -102,6 +102,7 @@ module MOM_dynamics_unsplit use MOM_interface_heights, only : find_eta use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type +use MOM_open_boundary, only : ocean_OBC_type use MOM_open_boundary, only : Radiation_Open_Bdry_Conds, open_boundary_init use MOM_open_boundary, only : open_boundary_CS use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 72e4f56613..7055547e0a 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -65,7 +65,7 @@ module MOM_dynamics_unsplit_RK2 !* * !********+*********+*********+*********+*********+*********+*********+** -use MOM_variables, only : vertvisc_type, ocean_OBC_type, thermo_var_ptrs +use MOM_variables, only : vertvisc_type, thermo_var_ptrs use MOM_variables, only : ocean_internal_state, accel_diag_ptrs, cont_diag_ptrs use MOM_forcing_type, only : forcing use MOM_checksum_packages, only : MOM_thermo_chksum, MOM_state_chksum, MOM_accel_chksum @@ -100,6 +100,7 @@ module MOM_dynamics_unsplit_RK2 use MOM_hor_visc, only : horizontal_viscosity, hor_visc_init, hor_visc_CS use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type +use MOM_open_boundary, only : ocean_OBC_type use MOM_open_boundary, only : Radiation_Open_Bdry_Conds, open_boundary_init use MOM_open_boundary, only : open_boundary_CS use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS diff --git a/src/core/MOM_legacy_barotropic.F90 b/src/core/MOM_legacy_barotropic.F90 index 0b15fb6f3f..c6f077ec6a 100644 --- a/src/core/MOM_legacy_barotropic.F90 +++ b/src/core/MOM_legacy_barotropic.F90 @@ -107,13 +107,13 @@ module MOM_legacy_barotropic use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_io, only : vardesc, var_desc +use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE, OBC_NONE +use MOM_open_boundary, only : OBC_FLATHER_E, OBC_FLATHER_W +use MOM_open_boundary, only : OBC_FLATHER_N, OBC_FLATHER_S use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_tidal_forcing, only : tidal_forcing_sensitivity, tidal_forcing_CS use MOM_time_manager, only : time_type, set_time, operator(+), operator(-) use MOM_variables, only : BT_cont_type, alloc_bt_cont_type -use MOM_variables, only : ocean_OBC_type, OBC_SIMPLE, OBC_NONE -use MOM_variables, only : OBC_FLATHER_E, OBC_FLATHER_W -use MOM_variables, only : OBC_FLATHER_N, OBC_FLATHER_S use MOM_verticalGrid, only : verticalGrid_type implicit none ; private diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index b7db0be985..8f78795c2a 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -46,8 +46,6 @@ module MOM_open_boundary use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_variables, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE -use MOM_variables, only : OBC_FLATHER_E, OBC_FLATHER_W, OBC_FLATHER_N, OBC_FLATHER_S implicit none ; private @@ -69,6 +67,58 @@ module MOM_open_boundary ! default value is 10 m s-1. end type open_boundary_CS +integer, parameter, public :: OBC_NONE = 0, OBC_SIMPLE = 1, OBC_WALL = 2 +integer, parameter, public :: OBC_FLATHER_E = 4, OBC_FLATHER_W = 5 +integer, parameter, public :: OBC_FLATHER_N = 6, OBC_FLATHER_S = 7 + +type, public :: ocean_OBC_type +! This structure is used to apply specified open boundary conditions. + logical :: apply_OBC_u_flather_east = .false. ! If true, some zonal velocity + logical :: apply_OBC_u_flather_west = .false. ! points in the local domain use flather open + ! boundary conditions. + logical :: apply_OBC_v_flather_north = .false. ! If true, some meridional velocity + logical :: apply_OBC_v_flather_south = .false. ! points in the local domain use flather open + ! boundary conditions. + logical :: apply_OBC_u = .false. ! If true, some zonal or meridional velocity + logical :: apply_OBC_v = .false. ! points in the local domain use open + ! boundary conditions. + logical, pointer, dimension(:,:) :: & + OBC_mask_u => NULL(), & ! These arrays are true at zonal or meridional + OBC_mask_v => NULL() ! velocity points that have prescribed open boundary + ! conditions. + integer, pointer, dimension(:,:) :: & + OBC_kind_u => NULL(), & ! These arrays indicate the kind of open boundary + OBC_kind_v => NULL() ! conditions that are to be applied at the u and v + ! points, and can be OBC_NONE, OBC_SIMPLE, OBC_WALL, + ! or one of OBC_FLATHER_[EWNS]. Generally these + ! should be consistent with OBC_mask_[uv], with + ! OBC_mask_[uv] .false. for OBC_kind_[uv] = NONE + ! and true for all other values. + ! The following apply at points with OBC_kind_[uv] = OBC_FLATHER_x. + real, pointer, dimension(:,:,:) :: & + rx_old_u => NULL(), & ! The rx_old_u value for radiation coeff for u-velocity in x-direction + ry_old_v => NULL(), & ! The ry_old_v value for radiation coeff for v-velocity in y-direction + rx_old_h => NULL(), & ! The rx_old_h value for radiation coeff for layer thickness h in x-direction + ry_old_h => NULL() ! The ry_old_h value for radiation coeff for layer thickness h in y-direction + + ! The following can be used to specify the outer-domain values of the + ! surface height and barotropic velocity. If these are not allocated, the + ! default with Flather boundary conditions is the same as if they were + ! filled with zeros. With simple OBCs, these should not be allocated. + real, pointer, dimension(:,:) :: & + ubt_outer => NULL(), & ! The u-velocity in the outer domain, in m s-1. + vbt_outer => NULL(), & ! The v-velocity in the outer domain, in m s-1. + eta_outer_u => NULL(), & ! The sea surface height anomaly or water column + eta_outer_v => NULL() ! mass anomaly in the outer domain in m or kg m-2. + + ! The following apply at points with OBC_kind_[uv] = OBC_SIMPLE. + real, pointer, dimension(:,:,:) :: & + u => NULL(), & ! The prescribed values of the zonal (u) or meridional (v) + v => NULL(), & ! velocities at OBC points, in m s-1. + uh => NULL(), & ! The prescribed values of the zonal (uh) or meridional (vh) + vh => NULL() ! volume transports at OBC points, in m3 s-1. +end type ocean_OBC_type + integer :: id_clock_pass contains diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 42a619c9b9..fa1b2da980 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -235,59 +235,6 @@ module MOM_variables ! at the interfaces between each layer, in m2 s-2. end type vertvisc_type -integer, parameter, public :: OBC_NONE = 0, OBC_SIMPLE = 1, OBC_WALL = 2 -integer, parameter, public :: OBC_FLATHER_E = 4, OBC_FLATHER_W = 5 -integer, parameter, public :: OBC_FLATHER_N = 6, OBC_FLATHER_S = 7 - -type, public :: ocean_OBC_type -! This structure is used to apply specified open boundary conditions. - logical :: apply_OBC_u_flather_east = .false. ! If true, some zonal velocity - logical :: apply_OBC_u_flather_west = .false. ! points in the local domain use flather open - ! boundary conditions. - logical :: apply_OBC_v_flather_north = .false. ! If true, some meridional velocity - logical :: apply_OBC_v_flather_south = .false. ! points in the local domain use flather open - ! boundary conditions. - logical :: apply_OBC_u = .false. ! If true, some zonal or meridional velocity - logical :: apply_OBC_v = .false. ! points in the local domain use open - ! boundary conditions. - logical, pointer, dimension(:,:) :: & - OBC_mask_u => NULL(), & ! These arrays are true at zonal or meridional - OBC_mask_v => NULL() ! velocity points that have prescribed open boundary - ! conditions. - integer, pointer, dimension(:,:) :: & - OBC_kind_u => NULL(), & ! These arrays indicate the kind of open boundary - OBC_kind_v => NULL() ! conditions that are to be applied at the u and v - ! points, and can be OBC_NONE, OBC_SIMPLE, OBC_WALL, - ! or one of OBC_FLATHER_[EWNS]. Generally these - ! should be consistent with OBC_mask_[uv], with - ! OBC_mask_[uv] .false. for OBC_kind_[uv] = NONE - ! and true for all other values. - ! The following apply at points with OBC_kind_[uv] = OBC_FLATHER_x. - real, pointer, dimension(:,:,:) :: & - rx_old_u => NULL(), & ! The rx_old_u value for radiation coeff for u-velocity in x-direction - ry_old_v => NULL(), & ! The ry_old_v value for radiation coeff for v-velocity in y-direction - rx_old_h => NULL(), & ! The rx_old_h value for radiation coeff for layer thickness h in x-direction - ry_old_h => NULL() ! The ry_old_h value for radiation coeff for layer thickness h in y-direction - - ! The following can be used to specify the outer-domain values of the - ! surface height and barotropic velocity. If these are not allocated, the - ! default with Flather boundary conditions is the same as if they were - ! filled with zeros. With simple OBCs, these should not be allocated. - real, pointer, dimension(:,:) :: & - ubt_outer => NULL(), & ! The u-velocity in the outer domain, in m s-1. - vbt_outer => NULL(), & ! The v-velocity in the outer domain, in m s-1. - eta_outer_u => NULL(), & ! The sea surface height anomaly or water column - eta_outer_v => NULL() ! mass anomaly in the outer domain in m or kg m-2. - - ! The following apply at points with OBC_kind_[uv] = OBC_SIMPLE. - real, pointer, dimension(:,:,:) :: & - u => NULL(), & ! The prescribed values of the zonal (u) or meridional (v) - v => NULL(), & ! velocities at OBC points, in m s-1. - uh => NULL(), & ! The prescribed values of the zonal (uh) or meridional (vh) - vh => NULL() ! volume transports at OBC points, in m3 s-1. -end type ocean_OBC_type - - type, public :: BT_cont_type real, pointer, dimension(:,:) :: & FA_u_EE => NULL(), & ! The FA_u_XX variables are the effective open face diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 33f0f5634e..0f9568cd2c 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -21,6 +21,9 @@ module MOM_state_initialization use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE, MULTIPLE use MOM_io, only : slasher, vardesc, write_field use MOM_io, only : EAST_FACE, NORTH_FACE +use MOM_open_boundary, only : ocean_OBC_type +use MOM_open_boundary, only : OBC_NONE, OBC_SIMPLE, OBC_FLATHER_E, OBC_FLATHER_W +use MOM_open_boundary, only : OBC_FLATHER_N, OBC_FLATHER_S use MOM_grid_initialize, only : initialize_masks, set_grid_metrics use MOM_restart, only : restore_state, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, set_up_sponge_ML_density @@ -30,9 +33,7 @@ module MOM_state_initialization use MOM_string_functions, only : uppercase use MOM_time_manager, only : time_type, set_time use MOM_tracer_registry, only : add_tracer_OBC_values, tracer_registry_type -use MOM_variables, only : thermo_var_ptrs, ocean_OBC_type -use MOM_variables, only : OBC_NONE, OBC_SIMPLE, OBC_FLATHER_E, OBC_FLATHER_W -use MOM_variables, only : OBC_FLATHER_N, OBC_FLATHER_S +use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : setVerticalGridAxes, verticalGrid_type use MOM_ALE, only : pressure_gradient_plm use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 007804d62e..191eb62005 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -93,8 +93,8 @@ module MOM_hor_visc use MOM_grid, only : ocean_grid_type use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type -use MOM_variables, only : ocean_OBC_type, OBC_FLATHER_E, OBC_FLATHER_W -use MOM_variables, only : OBC_FLATHER_N, OBC_FLATHER_S +use MOM_open_boundary, only : ocean_OBC_type, OBC_FLATHER_E, OBC_FLATHER_W +use MOM_open_boundary, only : OBC_FLATHER_N, OBC_FLATHER_S use MOM_verticalGrid, only : verticalGrid_type implicit none ; private diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 84fb3d2aa8..77434af853 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -64,7 +64,7 @@ module MOM_set_visc use MOM_io, only : vardesc, var_desc use MOM_restart, only : register_restart_field, MOM_restart_CS use MOM_variables, only : thermo_var_ptrs -use MOM_variables, only : vertvisc_type, ocean_OBC_type +use MOM_variables, only : vertvisc_type use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 0a2cbf0d17..0ec1bc5dbe 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -82,12 +82,13 @@ module MOM_vert_friction use MOM_forcing_type, only : forcing use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type +use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE use MOM_PointAccel, only : write_u_accel, write_v_accel, PointAccel_init use MOM_PointAccel, only : PointAccel_CS use MOM_time_manager, only : time_type, time_type_to_real, operator(-) use MOM_variables, only : thermo_var_ptrs, vertvisc_type use MOM_variables, only : cont_diag_ptrs, accel_diag_ptrs -use MOM_variables, only : ocean_internal_state, ocean_OBC_type, OBC_SIMPLE +use MOM_variables, only : ocean_internal_state use MOM_verticalGrid, only : verticalGrid_type implicit none ; private diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index e7dcb22836..993b67eea9 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -62,13 +62,14 @@ module DOME_tracer use MOM_hor_index, only : hor_index_type use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data, slasher, vardesc, var_desc, query_vardesc +use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : register_restart_field, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type, get_time use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_registry, only : add_tracer_diagnostics, add_tracer_OBC_values use MOM_tracer_registry, only : tracer_vertdiff -use MOM_variables, only : surface, ocean_OBC_type +use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type use coupler_util, only : set_coupler_values, ind_csurf diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index 41181f3ab8..8ad94af4c0 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -73,6 +73,7 @@ module MOM_OCMIP2_CFC use MOM_hor_index, only : hor_index_type use MOM_grid, only : ocean_grid_type use MOM_io, only : file_exists, read_data, slasher, 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, get_time @@ -80,7 +81,7 @@ module MOM_OCMIP2_CFC use MOM_tracer_registry, only : add_tracer_diagnostics, add_tracer_OBC_values use MOM_tracer_registry, only : tracer_vertdiff use MOM_tracer_Z_init, only : tracer_Z_init -use MOM_variables, only : surface, ocean_OBC_type +use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type use coupler_util, only : extract_coupler_values, set_coupler_values diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 26ed11fe75..949039f7e5 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -14,9 +14,9 @@ module MOM_tracer_advect use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe 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_FLATHER_E +use MOM_open_boundary, only : OBC_FLATHER_W, OBC_FLATHER_N, OBC_FLATHER_S use MOM_tracer_registry, only : tracer_registry_type, tracer_type, MOM_tracer_chksum -use MOM_variables, only : ocean_OBC_type, OBC_FLATHER_E -use MOM_variables, only : OBC_FLATHER_W, OBC_FLATHER_N, OBC_FLATHER_S use MOM_verticalGrid, only : verticalGrid_type implicit none ; private diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 3a71eff968..49a40296c7 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -36,11 +36,12 @@ module MOM_tracer_flow_control use MOM_forcing_type, only : forcing, optics_type 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_tracer_registry, only : tracer_registry_type -use MOM_variables, only : surface, ocean_OBC_type, thermo_var_ptrs +use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type #include diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 4a7c6e6799..73b581d299 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -21,9 +21,10 @@ module MOM_tracer_hor_diff use MOM_neutral_diffusion, only : neutral_diffusion_init, neutral_diffusion_end use MOM_neutral_diffusion, only : neutral_diffusion_CS use MOM_neutral_diffusion, only : neutral_diffusion_calc_coeffs, neutral_diffusion +use MOM_open_boundary, only : ocean_OBC_type, OBC_FLATHER_E +use MOM_open_boundary, only : OBC_FLATHER_W, OBC_FLATHER_N, OBC_FLATHER_S use MOM_tracer_registry, only : tracer_registry_type, tracer_type, MOM_tracer_chksum -use MOM_variables, only : ocean_OBC_type, thermo_var_ptrs, OBC_FLATHER_E -use MOM_variables, only : OBC_FLATHER_W, OBC_FLATHER_N, OBC_FLATHER_S +use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type implicit none ; private diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index a490299e76..c5eae04fe2 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -62,13 +62,14 @@ module advection_test_tracer use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_io, only : file_exists, read_data, slasher, vardesc, var_desc, query_vardesc +use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : register_restart_field, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type, get_time use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_registry, only : add_tracer_diagnostics, add_tracer_OBC_values use MOM_tracer_registry, only : tracer_vertdiff -use MOM_variables, only : surface, ocean_OBC_type +use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type use coupler_util, only : set_coupler_values, ind_csurf diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 93925d6e3a..0f17aa9b01 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -63,6 +63,7 @@ module regional_dyes use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_io, only : file_exists, read_data, slasher, 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, get_time @@ -70,7 +71,7 @@ module regional_dyes use MOM_tracer_registry, only : add_tracer_diagnostics, add_tracer_OBC_values use MOM_tracer_registry, only : tracer_vertdiff use MOM_tracer_Z_init, only : tracer_Z_init -use MOM_variables, only : surface, ocean_OBC_type +use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type use coupler_util, only : set_coupler_values, ind_csurf diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 9f7be83e04..04bfa4532d 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -63,6 +63,7 @@ module ideal_age_example use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_io, only : file_exists, read_data, slasher, 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, get_time @@ -70,7 +71,7 @@ module ideal_age_example use MOM_tracer_registry, only : add_tracer_diagnostics, add_tracer_OBC_values use MOM_tracer_registry, only : tracer_vertdiff use MOM_tracer_Z_init, only : tracer_Z_init -use MOM_variables, only : surface, ocean_OBC_type +use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type use coupler_util, only : set_coupler_values, ind_csurf diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index 72b90bd135..d2725cdb5d 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -63,6 +63,7 @@ module oil_tracer use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_io, only : file_exists, read_data, slasher, 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, get_time @@ -70,7 +71,7 @@ module oil_tracer use MOM_tracer_registry, only : add_tracer_diagnostics, add_tracer_OBC_values use MOM_tracer_registry, only : tracer_vertdiff use MOM_tracer_Z_init, only : tracer_Z_init -use MOM_variables, only : surface, ocean_OBC_type +use MOM_variables, only : surface use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use coupler_util, only : set_coupler_values, ind_csurf diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 3b63b32056..8b5218276e 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -59,12 +59,13 @@ module USER_tracer_example use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_io, only : file_exists, read_data, slasher, vardesc, var_desc, query_vardesc +use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : register_restart_field, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type, get_time use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_registry, only : add_tracer_diagnostics, add_tracer_OBC_values -use MOM_variables, only : surface, ocean_OBC_type +use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type use coupler_util, only : set_coupler_values, ind_csurf diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 0e96df8f28..fcf8367bcb 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -9,7 +9,7 @@ module DOME2d_initialization use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE use MOM_io, only : write_field, slasher, vardesc use MOM_sponge, only : sponge_CS, set_up_sponge_field, initialize_sponge -use MOM_variables, only : thermo_var_ptrs, ocean_OBC_type +use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 62ce8b6913..b94fb69a18 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -24,8 +24,9 @@ module DOME_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type +use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE use MOM_tracer_registry, only : tracer_registry_type, add_tracer_OBC_values -use MOM_variables, only : thermo_var_ptrs, ocean_OBC_type, OBC_NONE, OBC_SIMPLE +use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 0328e70d2b..1a08d800f2 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -27,7 +27,7 @@ module ISOMIP_initialization use MOM_io, only : close_file, fieldtype, file_exists use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE use MOM_io, only : write_field, slasher, vardesc -use MOM_variables, only : thermo_var_ptrs, ocean_OBC_type +use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index 492fd2e8ee..ad176ae4d3 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -27,10 +27,8 @@ module Phillips_initialization use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE use MOM_io, only : write_field, slasher use MOM_sponge, only : set_up_sponge_field, initialize_sponge, sponge_CS -use MOM_tracer_registry, only : tracer_registry_type, add_tracer_OBC_values +use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : thermo_var_ptrs -use MOM_variables, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE -use MOM_variables, only : OBC_FLATHER_E, OBC_FLATHER_W, OBC_FLATHER_N, OBC_FLATHER_S use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index dd55e8324a..149ff3db25 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -10,7 +10,7 @@ module Rossby_front_2d_initialization use MOM_io, only : close_file, fieldtype, file_exists use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE use MOM_io, only : write_field, slasher, vardesc -use MOM_variables, only : thermo_var_ptrs, ocean_OBC_type +use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index d8b2414df6..2831a5a47f 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -26,7 +26,7 @@ module adjustment_initialization use MOM_io, only : close_file, fieldtype, file_exists use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE use MOM_io, only : write_field, slasher -use MOM_variables, only : thermo_var_ptrs, ocean_OBC_type +use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index d003773f08..c39c9db0f4 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -24,9 +24,8 @@ module benchmark_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type -use MOM_tracer_registry, only : tracer_registry_type, add_tracer_OBC_values +use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : thermo_var_ptrs -use MOM_variables, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 1c1502eaff..80e326674f 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -24,8 +24,8 @@ module circle_obcs_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type -use MOM_tracer_registry, only : tracer_registry_type, add_tracer_OBC_values -use MOM_variables, only : thermo_var_ptrs, ocean_OBC_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index 5ce6145a7a..cc1fe5f226 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -23,7 +23,7 @@ module external_gwave_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type -use MOM_tracer_registry, only : tracer_registry_type, add_tracer_OBC_values +use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : thermo_var_ptrs implicit none ; private diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index 222e45dc98..71822a84c2 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -23,7 +23,7 @@ module lock_exchange_initialization use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type -use MOM_tracer_registry, only : tracer_registry_type, add_tracer_OBC_values +use MOM_tracer_registry, only : tracer_registry_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 7cb9ba4612..e25d05c5c1 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -28,8 +28,8 @@ module seamount_initialization use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE use MOM_io, only : write_field, slasher, vardesc use MOM_sponge, only : set_up_sponge_field, initialize_sponge, sponge_CS -use MOM_tracer_registry, only : tracer_registry_type, add_tracer_OBC_values -use MOM_variables, only : thermo_var_ptrs, ocean_OBC_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type use regrid_consts, only : coordinateMode, DEFAULT_COORDINATE_MODE diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 791c1ddcd6..e0a48fa135 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -28,8 +28,8 @@ module sloshing_initialization use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE use MOM_io, only : write_field, slasher use MOM_sponge, only : set_up_sponge_field, initialize_sponge, sponge_CS -use MOM_tracer_registry, only : tracer_registry_type, add_tracer_OBC_values -use MOM_variables, only : thermo_var_ptrs, ocean_OBC_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 3a01978e67..0364ef884c 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -26,10 +26,11 @@ module user_initialization use MOM_io, only : close_file, fieldtype, file_exists use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE use MOM_io, only : write_field, slasher +use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE +use MOM_open_boundary, only : OBC_FLATHER_E, OBC_FLATHER_W, OBC_FLATHER_N, OBC_FLATHER_S use MOM_sponge, only : set_up_sponge_field, initialize_sponge, sponge_CS use MOM_tracer_registry, only : tracer_registry_type, add_tracer_OBC_values -use MOM_variables, only : thermo_var_ptrs, ocean_OBC_type, OBC_NONE, OBC_SIMPLE -use MOM_variables, only : OBC_FLATHER_E, OBC_FLATHER_W, OBC_FLATHER_N, OBC_FLATHER_S +use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type implicit none ; private From 2db5e11005969fd523a9f820244374d8add13a19 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 13 Jun 2016 15:00:50 -0400 Subject: [PATCH 02/33] Doxygenized MOM_open_boundary.F90 - Just doxygenized comments. - No code changes. - No answer changes. --- src/core/MOM_open_boundary.F90 | 183 ++++++++++++++------------------- 1 file changed, 79 insertions(+), 104 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 8f78795c2a..ea419ae4c6 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1,44 +1,5 @@ +!> Controls where open boundary conditions are applied module MOM_open_boundary -!*********************************************************************** -!* GNU General Public License * -!* This file is a part of MOM. * -!* * -!* MOM is free software; you can redistribute it and/or modify it and * -!* are expected to follow the terms of the GNU General Public License * -!* as published by the Free Software Foundation; either version 2 of * -!* the License, or (at your option) any later version. * -!* * -!* MOM is distributed in the hope that it will be useful, but WITHOUT * -!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * -!* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public * -!* License for more details. * -!* * -!* For the full text of the GNU General Public License, * -!* write to: Free Software Foundation, Inc., * -!* 675 Mass Ave, Cambridge, MA 02139, USA. * -!* or see: http://www.gnu.org/licenses/gpl.html * -!*********************************************************************** - -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Mehmet Ilicak and Robert Hallberg, 2010 * -!* * -!* This module implements some aspects of internal open boundary * -!* conditions in MOM. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q, CoriolisBu * -!* j+1 > o > o > At ^: v, tauy * -!* j x ^ x ^ x At >: u, taux * -!* j > o > o > At o: h, bathyT, buoy, tr, T, S, Rml, ustar * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : diag_ctrl, time_type @@ -53,88 +14,93 @@ module MOM_open_boundary public Radiation_Open_Bdry_Conds, open_boundary_init, open_boundary_end +!> The control structure for open-boundaries type, public :: open_boundary_CS ; private - real :: gamma_uv ! The relative weighting for the baroclinic radiation - ! velocities (or speed of characteristics) at the - ! new time level (1) or the running mean (0) for velocities. - ! Valid values range from 0 to 1, with a default of 0.3. - real :: gamma_h ! The relative weighting for the baroclinic radiation - ! velocities (or speed of characteristics) at the - ! new time level (1) or the running mean (0) for thicknesses. - ! Valid values range from 0 to 1, with a default of 0.2. - real :: rx_max ! The maximum magnitude of the baroclinic radiation - ! velocity (or speed of characteristics), in m s-1. The - ! default value is 10 m s-1. + real :: gamma_uv !< The relative weighting for the baroclinic radiation + !! velocities (or speed of characteristics) at the + !! new time level (1) or the running mean (0) for velocities. + !! Valid values range from 0 to 1, with a default of 0.3. + real :: gamma_h !< The relative weighting for the baroclinic radiation + !! velocities (or speed of characteristics) at the + !! new time level (1) or the running mean (0) for thicknesses. + !! Valid values range from 0 to 1, with a default of 0.2. + real :: rx_max !< The maximum magnitude of the baroclinic radiation + !! velocity (or speed of characteristics), in m s-1. The + !! default value is 10 m s-1. end type open_boundary_CS integer, parameter, public :: OBC_NONE = 0, OBC_SIMPLE = 1, OBC_WALL = 2 integer, parameter, public :: OBC_FLATHER_E = 4, OBC_FLATHER_W = 5 integer, parameter, public :: OBC_FLATHER_N = 6, OBC_FLATHER_S = 7 +!> Open-boundary data type, public :: ocean_OBC_type -! This structure is used to apply specified open boundary conditions. - logical :: apply_OBC_u_flather_east = .false. ! If true, some zonal velocity - logical :: apply_OBC_u_flather_west = .false. ! points in the local domain use flather open - ! boundary conditions. - logical :: apply_OBC_v_flather_north = .false. ! If true, some meridional velocity - logical :: apply_OBC_v_flather_south = .false. ! points in the local domain use flather open - ! boundary conditions. - logical :: apply_OBC_u = .false. ! If true, some zonal or meridional velocity - logical :: apply_OBC_v = .false. ! points in the local domain use open - ! boundary conditions. + logical :: apply_OBC_u_flather_east = .false. !< True if any zonal velocity points in the + !! local domain use east-facing Flather OBCs. + logical :: apply_OBC_u_flather_west = .false. !< True if any zonal velocity points in the + !! local domain use west-facing Flather OBCs. + logical :: apply_OBC_v_flather_north = .false. !< True if any zonal velocity points in the + !! local domain use north-facing Flather OBCs. + logical :: apply_OBC_v_flather_south = .false. !< True if any zonal velocity points in the + !! local domain use south-facing Flather OBCs. + logical :: apply_OBC_u = .false. !< True if any zonal velocity points in to local domain use OBCs. + logical :: apply_OBC_v = .false. !< True if any meridional velocity points in to local domain use OBCs. logical, pointer, dimension(:,:) :: & - OBC_mask_u => NULL(), & ! These arrays are true at zonal or meridional - OBC_mask_v => NULL() ! velocity points that have prescribed open boundary - ! conditions. + OBC_mask_u => NULL(), & !< True at zonal velocity points that have prescribed OBCs. + OBC_mask_v => NULL() !< True at meridional velocity points that have prescribed OBCs. + ! These arrays indicate the kind of open boundary conditions that are to be applied at the u and v + ! points, and can be OBC_NONE, OBC_SIMPLE, OBC_WALL, or one of OBC_FLATHER_[EWNS]. Generally these + ! should be consistent with OBC_mask_[uv], with OBC_mask_[uv] .false. for OBC_kind_[uv] = NONE + ! and true for all other values. integer, pointer, dimension(:,:) :: & - OBC_kind_u => NULL(), & ! These arrays indicate the kind of open boundary - OBC_kind_v => NULL() ! conditions that are to be applied at the u and v - ! points, and can be OBC_NONE, OBC_SIMPLE, OBC_WALL, - ! or one of OBC_FLATHER_[EWNS]. Generally these - ! should be consistent with OBC_mask_[uv], with - ! OBC_mask_[uv] .false. for OBC_kind_[uv] = NONE - ! and true for all other values. + OBC_kind_u => NULL(), & !< Type of OBC at u-points. + OBC_kind_v => NULL() !< Type of OBC at v-points. ! The following apply at points with OBC_kind_[uv] = OBC_FLATHER_x. real, pointer, dimension(:,:,:) :: & - rx_old_u => NULL(), & ! The rx_old_u value for radiation coeff for u-velocity in x-direction - ry_old_v => NULL(), & ! The ry_old_v value for radiation coeff for v-velocity in y-direction - rx_old_h => NULL(), & ! The rx_old_h value for radiation coeff for layer thickness h in x-direction - ry_old_h => NULL() ! The ry_old_h value for radiation coeff for layer thickness h in y-direction + rx_old_u => NULL(), & !< The rx_old_u value for radiation coeff for u-velocity in x-direction + ry_old_v => NULL(), & !< The ry_old_v value for radiation coeff for v-velocity in y-direction + rx_old_h => NULL(), & !< The rx_old_h value for radiation coeff for layer thickness h in x-direction + ry_old_h => NULL() !< The ry_old_h value for radiation coeff for layer thickness h in y-direction ! The following can be used to specify the outer-domain values of the ! surface height and barotropic velocity. If these are not allocated, the ! default with Flather boundary conditions is the same as if they were ! filled with zeros. With simple OBCs, these should not be allocated. real, pointer, dimension(:,:) :: & - ubt_outer => NULL(), & ! The u-velocity in the outer domain, in m s-1. - vbt_outer => NULL(), & ! The v-velocity in the outer domain, in m s-1. - eta_outer_u => NULL(), & ! The sea surface height anomaly or water column - eta_outer_v => NULL() ! mass anomaly in the outer domain in m or kg m-2. + ubt_outer => NULL(), & !< The u-velocity in the outer domain, in m s-1. + vbt_outer => NULL(), & !< The v-velocity in the outer domain, in m s-1. + eta_outer_u => NULL(), & !< The SSH anomaly in the outer domain, in m or kg m-2. + eta_outer_v => NULL() !< The SSH anomaly in the outer domain, in m or kg m-2. ! The following apply at points with OBC_kind_[uv] = OBC_SIMPLE. real, pointer, dimension(:,:,:) :: & - u => NULL(), & ! The prescribed values of the zonal (u) or meridional (v) - v => NULL(), & ! velocities at OBC points, in m s-1. - uh => NULL(), & ! The prescribed values of the zonal (uh) or meridional (vh) - vh => NULL() ! volume transports at OBC points, in m3 s-1. + u => NULL(), & !< The prescribed values of the zonal velocity (u) at OBC points. + v => NULL(), & !< The prescribed values of the meridional velocity (v) at OBC points. + uh => NULL(), & !< The prescribed values of the zonal volume transport (uh) at OBC points. + vh => NULL() !< The prescribed values of the meridional volume transport (vh) at OBC points. end type ocean_OBC_type integer :: id_clock_pass +character(len=40) :: mod = "MOM_open_boundary" ! This module's name. +! This include declares and sets the variable "version". +#include "version_variable.h" + contains +!> Diagnose radiation conditions at open boundaries subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & h_new, h_old, G, CS) - type(ocean_grid_type), intent(inout) :: G - type(ocean_OBC_type), pointer :: OBC + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(ocean_OBC_type), pointer :: OBC !< Open boundary data real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_new real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u_old real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_new real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_old real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_new real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old - type(open_boundary_CS), pointer :: CS - + type(open_boundary_CS), pointer :: CS !< Open boundary control structure + ! Local variables real :: dhdt, dhdx, gamma_u, gamma_h, gamma_v real :: rx_max, ry_max ! coefficients for radiation real :: rx_new, rx_avg ! coefficients for radiation @@ -239,26 +205,18 @@ subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & end subroutine Radiation_Open_Bdry_Conds +!> Initialize open boundary control structure subroutine open_boundary_init(Time, G, param_file, diag, CS) - type(time_type), target, intent(in) :: Time - type(ocean_grid_type), intent(in) :: G - type(param_file_type), intent(in) :: param_file - type(diag_ctrl), target, intent(inout) :: diag - type(open_boundary_CS), pointer :: CS -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module -! This include declares and sets the variable "version". -#include "version_variable.h" - character(len=40) :: mod = "MOM_open_boundary" ! This module's name. + type(time_type), target, intent(in) :: Time !< Current model time + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(param_file_type), intent(in) :: param_file !< Parameter file handle + type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure + type(open_boundary_CS), pointer :: CS !< Open boundary control structure + ! Local variables logical :: flather_east, flather_west, flather_north, flather_south if (associated(CS)) then - call MOM_error(WARNING, "continuity_init called with associated control structure.") + call MOM_error(WARNING, "MOM_open_boundary: open_boundary_init called with associated control structure.") return endif @@ -307,9 +265,26 @@ subroutine open_boundary_init(Time, G, param_file, diag, CS) end subroutine open_boundary_init +!> Deallocate open boundary data subroutine open_boundary_end(CS) - type(open_boundary_CS), pointer :: CS + type(open_boundary_CS), pointer :: CS !< Open boundary control structure deallocate(CS) end subroutine open_boundary_end +!> \namespace mom_open_boundary +!! This module implements some aspects of internal open boundary +!! conditions in MOM. +!! +!! A small fragment of the grid is shown below: +!! +!! j+1 x ^ x ^ x At x: q, CoriolisBu +!! j+1 > o > o > At ^: v, tauy +!! j x ^ x ^ x At >: u, taux +!! j > o > o > At o: h, bathyT, buoy, tr, T, S, Rml, ustar +!! j-1 x ^ x ^ x +!! i-1 i i+1 At x & ^: +!! i i+1 At > & o: +!! +!! The boundaries always run through q grid points (x). + end module MOM_open_boundary From ec8ba6f13151b40656091a25d952db3f577e554e Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 13 Jun 2016 16:20:21 -0400 Subject: [PATCH 03/33] Moved open_boundary_CS parameters into ocean_OBC_type - Although open_boundary_CS was a true "control structure" and ocean_OBC_type was a data container with public members I am moving the three parameters in open_boundary_CS into ocean_OBC_type and removed open_boundary_CS as part of a larger refactoring. - No answer changes. --- src/core/MOM_dynamics_legacy_split.F90 | 8 ++-- src/core/MOM_dynamics_split_RK2.F90 | 8 ++-- src/core/MOM_dynamics_unsplit.F90 | 4 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 4 +- src/core/MOM_open_boundary.F90 | 61 +++++++++++--------------- 5 files changed, 33 insertions(+), 52 deletions(-) diff --git a/src/core/MOM_dynamics_legacy_split.F90 b/src/core/MOM_dynamics_legacy_split.F90 index 3ad5c3363c..944fe27e9a 100644 --- a/src/core/MOM_dynamics_legacy_split.F90 +++ b/src/core/MOM_dynamics_legacy_split.F90 @@ -111,7 +111,6 @@ module MOM_dynamics_legacy_split use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type use MOM_open_boundary, only : Radiation_Open_Bdry_Conds, open_boundary_init -use MOM_open_boundary, only : open_boundary_CS use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_remnant @@ -241,7 +240,6 @@ module MOM_dynamics_legacy_split type(legacy_barotropic_CS), pointer :: barotropic_CSp => NULL() type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() type(set_visc_CS), pointer :: set_visc_CSp => NULL() - type(open_boundary_CS), pointer :: open_boundary_CSp => NULL() type(ocean_OBC_type), pointer :: OBC => NULL() ! A pointer to an open boundary ! condition type that specifies whether, where, and what open boundary ! conditions are used. If no open BCs are used, this pointer stays @@ -739,7 +737,7 @@ subroutine step_MOM_dyn_legacy_split(u, v, h, tv, visc, & if (associated(CS%OBC)) then call Radiation_Open_Bdry_Conds(CS%OBC, u_av, u_old_rad_OBC, v_av, & - v_old_rad_OBC, hp, h_old_rad_OBC, G, CS%open_boundary_CSp) + v_old_rad_OBC, hp, h_old_rad_OBC, G) endif ! h_av = (h + hp)/2 @@ -998,7 +996,7 @@ subroutine step_MOM_dyn_legacy_split(u, v, h, tv, visc, & if (associated(CS%OBC)) then call Radiation_Open_Bdry_Conds(CS%OBC, u, u_old_rad_OBC, v, & - v_old_rad_OBC, h, h_old_rad_OBC, G, CS%open_boundary_CSp) + v_old_rad_OBC, h, h_old_rad_OBC, G) endif ! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in. @@ -1382,7 +1380,7 @@ subroutine initialize_dyn_legacy_split(u, v, h, uh, vh, eta, Time, G, GV, param_ if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp if (associated(OBC)) then CS%OBC => OBC - call open_boundary_init(Time, G, param_file, diag, CS%open_boundary_CSp) + call open_boundary_init(Time, G, param_file, diag, CS%OBC) endif if (.not. query_initialized(CS%eta,"sfc",restart_CS)) then diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index b65ab8281c..e107e98f2c 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -47,7 +47,6 @@ module MOM_dynamics_split_RK2 use MOM_MEKE_types, only : MEKE_type use MOM_open_boundary, only : ocean_OBC_type use MOM_open_boundary, only : Radiation_Open_Bdry_Conds, open_boundary_init -use MOM_open_boundary, only : open_boundary_CS use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS @@ -161,7 +160,6 @@ module MOM_dynamics_split_RK2 type(barotropic_CS), pointer :: barotropic_CSp => NULL() type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() type(set_visc_CS), pointer :: set_visc_CSp => NULL() - type(open_boundary_CS), pointer :: open_boundary_CSp => NULL() type(tidal_forcing_CS), pointer :: tides_CSp => NULL() type(ocean_OBC_type), pointer :: OBC => NULL() !< A pointer to an open boundary @@ -640,7 +638,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (associated(CS%OBC)) then call Radiation_Open_Bdry_Conds(CS%OBC, u_av, u_old_rad_OBC, v_av, & - v_old_rad_OBC, hp, h_old_rad_OBC, G, CS%open_boundary_CSp) + v_old_rad_OBC, hp, h_old_rad_OBC, G) endif ! h_av = (h + hp)/2 @@ -852,7 +850,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (associated(CS%OBC)) then call Radiation_Open_Bdry_Conds(CS%OBC, u, u_old_rad_OBC, v, & - v_old_rad_OBC, h, h_old_rad_OBC, G, CS%open_boundary_CSp) + v_old_rad_OBC, h, h_old_rad_OBC, G) endif ! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in. @@ -1143,7 +1141,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp if (associated(OBC)) then CS%OBC => OBC - call open_boundary_init(Time, G, param_file, diag, CS%open_boundary_CSp) + call open_boundary_init(Time, G, param_file, diag, CS%OBC) endif if (.not. query_initialized(CS%eta,"sfc",restart_CS)) then diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 6c50d2b80a..d13d506072 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -104,7 +104,6 @@ module MOM_dynamics_unsplit use MOM_MEKE_types, only : MEKE_type use MOM_open_boundary, only : ocean_OBC_type use MOM_open_boundary, only : Radiation_Open_Bdry_Conds, open_boundary_init -use MOM_open_boundary, only : open_boundary_CS use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS @@ -156,7 +155,6 @@ module MOM_dynamics_unsplit type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() type(set_visc_CS), pointer :: set_visc_CSp => NULL() - type(open_boundary_CS), pointer :: open_boundary_CSp => NULL() type(ocean_OBC_type), pointer :: OBC => NULL() ! A pointer to an open boundary ! condition type that specifies whether, where, and what open boundary ! conditions are used. If no open BCs are used, this pointer stays @@ -682,7 +680,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, param_file, diag, CS, & if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp if (associated(OBC)) then CS%OBC => OBC - call open_boundary_init(Time, G, param_file, diag, CS%open_boundary_CSp) + call open_boundary_init(Time, G, param_file, diag, CS%OBC) endif flux_units = get_flux_units(GV) diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 7055547e0a..f6582787c3 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -102,7 +102,6 @@ module MOM_dynamics_unsplit_RK2 use MOM_MEKE_types, only : MEKE_type use MOM_open_boundary, only : ocean_OBC_type use MOM_open_boundary, only : Radiation_Open_Bdry_Conds, open_boundary_init -use MOM_open_boundary, only : open_boundary_CS use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS @@ -162,7 +161,6 @@ module MOM_dynamics_unsplit_RK2 type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() type(set_visc_CS), pointer :: set_visc_CSp => NULL() - type(open_boundary_CS), pointer :: open_boundary_CSp => NULL() type(ocean_OBC_type), pointer :: OBC => NULL() ! A pointer to an open boundary ! condition type that specifies whether, where, and what open boundary ! conditions are used. If no open BCs are used, this pointer stays @@ -646,7 +644,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, param_file, diag, CS if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp if (associated(OBC)) then CS%OBC => OBC - call open_boundary_init(Time, G, param_file, diag, CS%open_boundary_CSp) + call open_boundary_init(Time, G, param_file, diag, CS%OBC) endif flux_units = get_flux_units(GV) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index ea419ae4c6..f0bffa6d49 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -14,21 +14,6 @@ module MOM_open_boundary public Radiation_Open_Bdry_Conds, open_boundary_init, open_boundary_end -!> The control structure for open-boundaries -type, public :: open_boundary_CS ; private - real :: gamma_uv !< The relative weighting for the baroclinic radiation - !! velocities (or speed of characteristics) at the - !! new time level (1) or the running mean (0) for velocities. - !! Valid values range from 0 to 1, with a default of 0.3. - real :: gamma_h !< The relative weighting for the baroclinic radiation - !! velocities (or speed of characteristics) at the - !! new time level (1) or the running mean (0) for thicknesses. - !! Valid values range from 0 to 1, with a default of 0.2. - real :: rx_max !< The maximum magnitude of the baroclinic radiation - !! velocity (or speed of characteristics), in m s-1. The - !! default value is 10 m s-1. -end type open_boundary_CS - integer, parameter, public :: OBC_NONE = 0, OBC_SIMPLE = 1, OBC_WALL = 2 integer, parameter, public :: OBC_FLATHER_E = 4, OBC_FLATHER_W = 5 integer, parameter, public :: OBC_FLATHER_N = 6, OBC_FLATHER_S = 7 @@ -78,6 +63,19 @@ module MOM_open_boundary v => NULL(), & !< The prescribed values of the meridional velocity (v) at OBC points. uh => NULL(), & !< The prescribed values of the zonal volume transport (uh) at OBC points. vh => NULL() !< The prescribed values of the meridional volume transport (vh) at OBC points. + + ! The following parameters are used in the baroclinic radiation code: + real :: gamma_uv !< The relative weighting for the baroclinic radiation + !! velocities (or speed of characteristics) at the + !! new time level (1) or the running mean (0) for velocities. + !! Valid values range from 0 to 1, with a default of 0.3. + real :: gamma_h !< The relative weighting for the baroclinic radiation + !! velocities (or speed of characteristics) at the + !! new time level (1) or the running mean (0) for thicknesses. + !! Valid values range from 0 to 1, with a default of 0.2. + real :: rx_max !< The maximum magnitude of the baroclinic radiation + !! velocity (or speed of characteristics), in m s-1. The + !! default value is 10 m s-1. end type ocean_OBC_type integer :: id_clock_pass @@ -90,16 +88,15 @@ module MOM_open_boundary !> Diagnose radiation conditions at open boundaries subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & - h_new, h_old, G, CS) + h_new, h_old, G) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure - type(ocean_OBC_type), pointer :: OBC !< Open boundary data + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_new real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u_old real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_new real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_old real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_new real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old - type(open_boundary_CS), pointer :: CS !< Open boundary control structure ! Local variables real :: dhdt, dhdx, gamma_u, gamma_h, gamma_v real :: rx_max, ry_max ! coefficients for radiation @@ -112,11 +109,9 @@ subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & if (.not.(OBC%apply_OBC_u_flather_east .or. OBC%apply_OBC_u_flather_west .or. & OBC%apply_OBC_v_flather_north .or. OBC%apply_OBC_v_flather_south)) & return - if (.not.associated(CS)) call MOM_error(FATAL, & - "MOM_open_boundary: Module must be initialized before it is used.") - gamma_u = CS%gamma_uv ; gamma_v = CS%gamma_uv ; gamma_h = CS%gamma_h - rx_max = CS%rx_max ; ry_max = CS%rx_max + gamma_u = OBC%gamma_uv ; gamma_v = OBC%gamma_uv ; gamma_h = OBC%gamma_h + rx_max = OBC%rx_max ; ry_max = OBC%rx_max if (OBC%apply_OBC_u_flather_east .or. OBC%apply_OBC_u_flather_west) then do k=1,nz ; do j=js,je ; do I=is-1,ie ; if (OBC%OBC_mask_u(I,j)) then @@ -206,20 +201,15 @@ subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & end subroutine Radiation_Open_Bdry_Conds !> Initialize open boundary control structure -subroutine open_boundary_init(Time, G, param_file, diag, CS) +subroutine open_boundary_init(Time, G, param_file, diag, OBC) type(time_type), target, intent(in) :: Time !< Current model time type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(param_file_type), intent(in) :: param_file !< Parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(open_boundary_CS), pointer :: CS !< Open boundary control structure + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure ! Local variables logical :: flather_east, flather_west, flather_north, flather_south - if (associated(CS)) then - call MOM_error(WARNING, "MOM_open_boundary: open_boundary_init called with associated control structure.") - return - endif - call log_version(param_file, mod, version) call get_param(param_file, mod, "APPLY_OBC_U_FLATHER_EAST", flather_east, & "If true, some zonal velocity points use Flather open \n"//& @@ -240,20 +230,19 @@ subroutine open_boundary_init(Time, G, param_file, diag, CS) if (.not.(flather_east .or. flather_west .or. flather_north .or. & flather_south)) return - allocate(CS) - call get_param(param_file, mod, "OBC_RADIATION_MAX", CS%rx_max, & + call get_param(param_file, mod, "OBC_RADIATION_MAX", OBC%rx_max, & "The maximum magnitude of the baroclinic radiation \n"//& "velocity (or speed of characteristics). This is only \n"//& "used if one of the APPLY_OBC_[UV]_FLATHER_... is true.", & units="m s-1", default=10.0) - call get_param(param_file, mod, "OBC_RAD_VEL_WT", CS%gamma_uv, & + call get_param(param_file, mod, "OBC_RAD_VEL_WT", OBC%gamma_uv, & "The relative weighting for the baroclinic radiation \n"//& "velocities (or speed of characteristics) at the new \n"//& "time level (1) or the running mean (0) for velocities. \n"//& "Valid values range from 0 to 1. This is only used if \n"//& "one of the APPLY_OBC_[UV]_FLATHER_... is true.", & units="nondim", default=0.3) - call get_param(param_file, mod, "OBC_RAD_THICK_WT", CS%gamma_h, & + call get_param(param_file, mod, "OBC_RAD_THICK_WT", OBC%gamma_h, & "The relative weighting for the baroclinic radiation \n"//& "velocities (or speed of characteristics) at the new \n"//& "time level (1) or the running mean (0) for thicknesses. \n"//& @@ -266,9 +255,9 @@ subroutine open_boundary_init(Time, G, param_file, diag, CS) end subroutine open_boundary_init !> Deallocate open boundary data -subroutine open_boundary_end(CS) - type(open_boundary_CS), pointer :: CS !< Open boundary control structure - deallocate(CS) +subroutine open_boundary_end(OBC) + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + deallocate(OBC) end subroutine open_boundary_end !> \namespace mom_open_boundary From 98c4918e25ca33fe0c48b0e74f7f78a362eb5f24 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 13 Jun 2016 18:07:48 -0400 Subject: [PATCH 04/33] Moved calls to open_boundary_init() from MOM_dynamics_* to MOM.F90 - Each algorithm had it's own call to open_boundary_init() which simply set three parameters. I've moved this up to early in the main initialization sequence ready to re-purpose the s/r. - No answer changes. --- src/core/MOM.F90 | 2 +- src/core/MOM_dynamics_legacy_split.F90 | 7 ++----- src/core/MOM_dynamics_split_RK2.F90 | 7 ++----- src/core/MOM_dynamics_unsplit.F90 | 7 ++----- src/core/MOM_dynamics_unsplit_RK2.F90 | 7 ++----- 5 files changed, 9 insertions(+), 21 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index cc2f199989..3221d0371d 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1799,6 +1799,7 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, param_file, & dirs, CS%restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & CS%sponge_CSp, CS%ALE_sponge_CSp, CS%OBC, Time_in) + call open_boundary_init(Time, G, param_file, diag, CS%OBC) call cpu_clock_end(id_clock_MOM_init) call callTree_waypoint("returned from MOM_initialize_state() (initialize_MOM)") @@ -1916,7 +1917,6 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call wave_speed_init(Time, G, param_file, diag, CS%wave_speed_CSp) call VarMix_init(Time, G, param_file, diag, CS%VarMix, CS%wave_speed_CSp) call set_visc_init(Time, G, GV, param_file, diag, CS%visc, CS%set_visc_CSp) - if (CS%split) then allocate(eta(SZI_(G),SZJ_(G))) ; eta(:,:) = 0.0 if (CS%legacy_split) then diff --git a/src/core/MOM_dynamics_legacy_split.F90 b/src/core/MOM_dynamics_legacy_split.F90 index 944fe27e9a..77b9f3c6f5 100644 --- a/src/core/MOM_dynamics_legacy_split.F90 +++ b/src/core/MOM_dynamics_legacy_split.F90 @@ -110,7 +110,7 @@ module MOM_dynamics_legacy_split use MOM_interface_heights, only : find_eta use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type -use MOM_open_boundary, only : Radiation_Open_Bdry_Conds, open_boundary_init +use MOM_open_boundary, only : Radiation_Open_Bdry_Conds use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_remnant @@ -1378,10 +1378,7 @@ subroutine initialize_dyn_legacy_split(u, v, h, uh, vh, eta, Time, G, GV, param_ CS%set_visc_CSp => setVisc_CSp if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp - if (associated(OBC)) then - CS%OBC => OBC - call open_boundary_init(Time, G, param_file, diag, CS%OBC) - endif + if (associated(OBC)) CS%OBC => OBC if (.not. query_initialized(CS%eta,"sfc",restart_CS)) then ! Estimate eta based on the layer thicknesses - h. With the Boussinesq diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index e107e98f2c..2e2173a502 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -46,7 +46,7 @@ module MOM_dynamics_split_RK2 use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type use MOM_open_boundary, only : ocean_OBC_type -use MOM_open_boundary, only : Radiation_Open_Bdry_Conds, open_boundary_init +use MOM_open_boundary, only : Radiation_Open_Bdry_Conds use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS @@ -1139,10 +1139,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil (LEN_TRIM(dirs%input_filename) == 1)) ) if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp - if (associated(OBC)) then - CS%OBC => OBC - call open_boundary_init(Time, G, param_file, diag, CS%OBC) - endif + if (associated(OBC)) CS%OBC => OBC if (.not. query_initialized(CS%eta,"sfc",restart_CS)) then ! Estimate eta based on the layer thicknesses - h. With the Boussinesq diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index d13d506072..fc392cbb88 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -103,7 +103,7 @@ module MOM_dynamics_unsplit use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type use MOM_open_boundary, only : ocean_OBC_type -use MOM_open_boundary, only : Radiation_Open_Bdry_Conds, open_boundary_init +use MOM_open_boundary, only : Radiation_Open_Bdry_Conds use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS @@ -678,10 +678,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, param_file, diag, CS, & CS%set_visc_CSp => setVisc_CSp if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp - if (associated(OBC)) then - CS%OBC => OBC - call open_boundary_init(Time, G, param_file, diag, CS%OBC) - endif + if (associated(OBC)) CS%OBC => OBC flux_units = get_flux_units(GV) CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index f6582787c3..8e228a9189 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -101,7 +101,7 @@ module MOM_dynamics_unsplit_RK2 use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type use MOM_open_boundary, only : ocean_OBC_type -use MOM_open_boundary, only : Radiation_Open_Bdry_Conds, open_boundary_init +use MOM_open_boundary, only : Radiation_Open_Bdry_Conds use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS @@ -642,10 +642,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, param_file, diag, CS CS%set_visc_CSp => setVisc_CSp if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp - if (associated(OBC)) then - CS%OBC => OBC - call open_boundary_init(Time, G, param_file, diag, CS%OBC) - endif + if (associated(OBC)) CS%OBC => OBC flux_units = get_flux_units(GV) CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & From 89b858f1d8d4b50927008c9ef85949c9be5d535a Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 13 Jun 2016 18:14:31 -0400 Subject: [PATCH 05/33] Re-ordered s/r in MOM_open_boundary.F90 - Trivial re-factor: changed order of subroutines to the same order as listed in the public list, ready for adding new subroutines in the logical place in the file. - No answer changes. --- src/core/MOM_open_boundary.F90 | 124 +++++++++++++++++---------------- 1 file changed, 63 insertions(+), 61 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index f0bffa6d49..1e769046e5 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -12,7 +12,9 @@ module MOM_open_boundary #include -public Radiation_Open_Bdry_Conds, open_boundary_init, open_boundary_end +public open_boundary_init +public open_boundary_end +public Radiation_Open_Bdry_Conds integer, parameter, public :: OBC_NONE = 0, OBC_SIMPLE = 1, OBC_WALL = 2 integer, parameter, public :: OBC_FLATHER_E = 4, OBC_FLATHER_W = 5 @@ -86,6 +88,66 @@ module MOM_open_boundary contains +!> Initialize open boundary control structure +subroutine open_boundary_init(Time, G, param_file, diag, OBC) + type(time_type), target, intent(in) :: Time !< Current model time + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(param_file_type), intent(in) :: param_file !< Parameter file handle + type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + ! Local variables + logical :: flather_east, flather_west, flather_north, flather_south + + call log_version(param_file, mod, version) + call get_param(param_file, mod, "APPLY_OBC_U_FLATHER_EAST", flather_east, & + "If true, some zonal velocity points use Flather open \n"//& + "boundary conditions on the east side of the ocean.", & + default=.false.) + call get_param(param_file, mod, "APPLY_OBC_U_FLATHER_WEST", flather_west, & + "If true, some zonal velocity points use Flather open \n"//& + "boundary conditions on the west side of the ocean.", & + default=.false.) + call get_param(param_file, mod, "APPLY_OBC_V_FLATHER_NORTH", flather_north, & + "If true, some meridional velocity points use Flather \n"//& + "open boundary conditions on the north side of the ocean.", & + default=.false.) + call get_param(param_file, mod, "APPLY_OBC_V_FLATHER_SOUTH", flather_south, & + "If true, some meridional velocity points use Flather \n"//& + "open boundary conditions on the north side of the ocean.", & + default=.false.) + if (.not.(flather_east .or. flather_west .or. flather_north .or. & + flather_south)) return + + call get_param(param_file, mod, "OBC_RADIATION_MAX", OBC%rx_max, & + "The maximum magnitude of the baroclinic radiation \n"//& + "velocity (or speed of characteristics). This is only \n"//& + "used if one of the APPLY_OBC_[UV]_FLATHER_... is true.", & + units="m s-1", default=10.0) + call get_param(param_file, mod, "OBC_RAD_VEL_WT", OBC%gamma_uv, & + "The relative weighting for the baroclinic radiation \n"//& + "velocities (or speed of characteristics) at the new \n"//& + "time level (1) or the running mean (0) for velocities. \n"//& + "Valid values range from 0 to 1. This is only used if \n"//& + "one of the APPLY_OBC_[UV]_FLATHER_... is true.", & + units="nondim", default=0.3) + call get_param(param_file, mod, "OBC_RAD_THICK_WT", OBC%gamma_h, & + "The relative weighting for the baroclinic radiation \n"//& + "velocities (or speed of characteristics) at the new \n"//& + "time level (1) or the running mean (0) for thicknesses. \n"//& + "Valid values range from 0 to 1. This is only used if \n"//& + "one of the APPLY_OBC_[UV]_FLATHER_... is true.", & + units="nondim", default=0.2) + + id_clock_pass = cpu_clock_id('(Ocean OBC halo updates)', grain=CLOCK_ROUTINE) + +end subroutine open_boundary_init + +!> Deallocate open boundary data +subroutine open_boundary_end(OBC) + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + deallocate(OBC) +end subroutine open_boundary_end + !> Diagnose radiation conditions at open boundaries subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & h_new, h_old, G) @@ -200,66 +262,6 @@ subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & end subroutine Radiation_Open_Bdry_Conds -!> Initialize open boundary control structure -subroutine open_boundary_init(Time, G, param_file, diag, OBC) - type(time_type), target, intent(in) :: Time !< Current model time - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(param_file_type), intent(in) :: param_file !< Parameter file handle - type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - ! Local variables - logical :: flather_east, flather_west, flather_north, flather_south - - call log_version(param_file, mod, version) - call get_param(param_file, mod, "APPLY_OBC_U_FLATHER_EAST", flather_east, & - "If true, some zonal velocity points use Flather open \n"//& - "boundary conditions on the east side of the ocean.", & - default=.false.) - call get_param(param_file, mod, "APPLY_OBC_U_FLATHER_WEST", flather_west, & - "If true, some zonal velocity points use Flather open \n"//& - "boundary conditions on the west side of the ocean.", & - default=.false.) - call get_param(param_file, mod, "APPLY_OBC_V_FLATHER_NORTH", flather_north, & - "If true, some meridional velocity points use Flather \n"//& - "open boundary conditions on the north side of the ocean.", & - default=.false.) - call get_param(param_file, mod, "APPLY_OBC_V_FLATHER_SOUTH", flather_south, & - "If true, some meridional velocity points use Flather \n"//& - "open boundary conditions on the north side of the ocean.", & - default=.false.) - if (.not.(flather_east .or. flather_west .or. flather_north .or. & - flather_south)) return - - call get_param(param_file, mod, "OBC_RADIATION_MAX", OBC%rx_max, & - "The maximum magnitude of the baroclinic radiation \n"//& - "velocity (or speed of characteristics). This is only \n"//& - "used if one of the APPLY_OBC_[UV]_FLATHER_... is true.", & - units="m s-1", default=10.0) - call get_param(param_file, mod, "OBC_RAD_VEL_WT", OBC%gamma_uv, & - "The relative weighting for the baroclinic radiation \n"//& - "velocities (or speed of characteristics) at the new \n"//& - "time level (1) or the running mean (0) for velocities. \n"//& - "Valid values range from 0 to 1. This is only used if \n"//& - "one of the APPLY_OBC_[UV]_FLATHER_... is true.", & - units="nondim", default=0.3) - call get_param(param_file, mod, "OBC_RAD_THICK_WT", OBC%gamma_h, & - "The relative weighting for the baroclinic radiation \n"//& - "velocities (or speed of characteristics) at the new \n"//& - "time level (1) or the running mean (0) for thicknesses. \n"//& - "Valid values range from 0 to 1. This is only used if \n"//& - "one of the APPLY_OBC_[UV]_FLATHER_... is true.", & - units="nondim", default=0.2) - - id_clock_pass = cpu_clock_id('(Ocean OBC halo updates)', grain=CLOCK_ROUTINE) - -end subroutine open_boundary_init - -!> Deallocate open boundary data -subroutine open_boundary_end(OBC) - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - deallocate(OBC) -end subroutine open_boundary_end - !> \namespace mom_open_boundary !! This module implements some aspects of internal open boundary !! conditions in MOM. From 83e50eb0dfe8454a0431a079bf716c1bac9a9b37 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 13 Jun 2016 20:26:35 -0400 Subject: [PATCH 06/33] Split out DOME OBC positions - Previously, s/r DOME_set_Open_Bdry_Conds() set both the OBC masks and the OBC data (inflow conditions). - DOME_set_OBC_positions() now sets the OBC masks. - DOME_set_OBC_data() replaces DOME_set_Open_Bdry_Conds() and only sets inflow data. - This is one step in a larger re-factor of OBC code. --- .../MOM_state_initialization.F90 | 5 +- src/user/DOME_initialization.F90 | 138 ++++++++---------- 2 files changed, 67 insertions(+), 76 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0f9568cd2c..fe310f51a3 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -42,7 +42,7 @@ module MOM_state_initialization use user_initialization, only : user_init_temperature_salinity use user_initialization, only : user_set_Open_Bdry_Conds, user_initialize_sponges use DOME_initialization, only : DOME_initialize_thickness -use DOME_initialization, only : DOME_set_Open_Bdry_Conds +use DOME_initialization, only : DOME_set_OBC_positions, DOME_set_OBC_data use DOME_initialization, only : DOME_initialize_sponges use ISOMIP_initialization, only : ISOMIP_initialize_thickness use ISOMIP_initialization, only : ISOMIP_initialize_sponges @@ -440,7 +440,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & " \t USER - call a user modified routine.", default="file", & fail_if_missing=.true.) if (trim(config) == "DOME") then - call DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, PF, tracer_Reg) + call DOME_set_OBC_positions(G, PF, OBC) + call DOME_set_OBC_data(OBC, tv, G, GV, PF, tracer_Reg) elseif (trim(config) == "USER") then call user_set_Open_Bdry_Conds(OBC, tv, G, PF, tracer_Reg) else diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index b94fb69a18..455cb559c5 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -37,7 +37,8 @@ module DOME_initialization public DOME_initialize_topography public DOME_initialize_thickness public DOME_initialize_sponges -public DOME_set_Open_Bdry_Conds +public DOME_set_OBC_positions +public DOME_set_OBC_data contains @@ -230,31 +231,69 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) endif end subroutine DOME_initialize_sponges -! ----------------------------------------------------------------------------- -! ----------------------------------------------------------------------------- +!> Set the positions of the open boundary needed for the DOME experiment. +subroutine DOME_set_OBC_positions(G, param_file, OBC) + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(param_file_type), intent(in) :: param_file !< Parameter file handle. + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure. + ! Local variables + character(len=40) :: mod = "DOME_set_OBC_positions" ! This subroutine's name. + integer :: i, j + logical :: any_OBC ! Set to true if any points in this subdomain use OBCs + + if (.not.associated(OBC)) allocate(OBC) + + call get_param(param_file, mod, "APPLY_OBC_U", OBC%apply_OBC_u, & + "If true, open boundary conditions may be set at some \n"//& + "u-points, with the configuration controlled by OBC_CONFIG", & + default=.false.) + call get_param(param_file, mod, "APPLY_OBC_V", OBC%apply_OBC_v, & + "If true, open boundary conditions may be set at some \n"//& + "v-points, with the configuration controlled by OBC_CONFIG", & + default=.false.) + + any_OBC = .false. + if (OBC%apply_OBC_u) then + ! Set where u points are determined by OBCs. + !allocate(OBC_mask_u(IsdB:IedB,jsd:jed)) ; OBC_mask_u(:,:) = .false. + call MOM_error(FATAL,"DOME_initialization, DOME_set_OBC_positions: "//& + "APPLY_OBC_U=True is not coded for the DOME experiment") + endif + if (OBC%apply_OBC_v) then + ! Set where v points are determined by OBCs. + allocate(OBC%OBC_mask_v(G%isd:G%ied,G%JsdB:G%JedB)) ; OBC%OBC_mask_v(:,:) = .false. + do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + if ((G%geoLonCv(i,J) > 1000.0) .and. (G%geoLonCv(i,J) < 1100.0) .and. & + (abs(G%geoLatCv(i,J) - G%gridLatB(G%JegB)) < 0.1)) then + OBC%OBC_mask_v(i,J) = .true. + any_OBC = .true. + endif + enddo ; enddo + endif + if (.not.any_OBC) then + ! If this PE does not have any OBC points then we do not need the mask + OBC%apply_OBC_v = .false. + deallocate(OBC%OBC_mask_v) + endif +end subroutine DOME_set_OBC_positions + !> This subroutine sets the properties of flow at open boundary conditions. !! This particular example is for the DOME inflow describe in Legg et al. 2006. -subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) +subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields, including potential - !! temperature and salinity or mixed layer density. Absent - !! fields have NULL ptrs. + !! temperature and salinity or mixed layer density. Absent + !! fields have NULL ptrs. 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(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry. - logical :: any_OBC ! Set to true if any points in this subdomain use - ! open boundary conditions. - logical, pointer, dimension(:,:) :: & - OBC_mask_u => NULL(), & ! These arrays are true at zonal or meridional - OBC_mask_v => NULL() ! velocity points that have prescribed open boundary - ! conditions. real, pointer, dimension(:,:,:) :: & OBC_T_u => NULL(), & ! These arrays should be allocated and set to OBC_T_v => NULL(), & ! specify the values of T and S that should come @@ -276,7 +315,7 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) ! thickness D_edge, in the same units as lat. real :: Ri_trans ! The shear Richardson number in the transition ! region of the specified shear profile. - character(len=40) :: mod = "DOME_set_Open_Bdry_Conds" ! This subroutine's name. + character(len=40) :: mod = "DOME_set_OBC_data" ! This subroutine's name. integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB @@ -289,56 +328,10 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) Ri_trans = 1.0/3.0 ! The shear Richardson number in the transition region ! region of the specified shear profile. - call get_param(param_file, mod, "APPLY_OBC_U", apply_OBC_u, & - "If true, open boundary conditions may be set at some \n"//& - "u-points, with the configuration controlled by OBC_CONFIG", & - default=.false.) - call get_param(param_file, mod, "APPLY_OBC_V", apply_OBC_v, & - "If true, open boundary conditions may be set at some \n"//& - "v-points, with the configuration controlled by OBC_CONFIG", & - default=.false.) - - if (apply_OBC_u) then - ! Determine where u points are applied. - allocate(OBC_mask_u(IsdB:IedB,jsd:jed)) ; OBC_mask_u(:,:) = .false. - any_OBC = .false. - do j=jsd,jed ; do I=IsdB,IedB - ! if (SOME_TEST_FOR_U_OPEN_BCS) then - ! OBC_mask_u(I,j) = .true. ; any_OBC = .true. - ! endif - enddo ; enddo - if (.not.any_OBC) then - ! This processor has no u points at which open boundary conditions are - ! to be applied. - apply_OBC_u = .false. - deallocate(OBC_mask_u) - endif - endif - if (apply_OBC_v) then - ! Determine where v points are applied. - allocate(OBC_mask_v(isd:ied,JsdB:JedB)) ; OBC_mask_v(:,:) = .false. - any_OBC = .false. - do J=JsdB,JedB ; do i=isd,ied - if ((G%geoLonCv(i,J) > 1000.0) .and. (G%geoLonCv(i,J) < 1100.0) .and. & - (abs(G%geoLatCv(i,J) - G%gridLatB(G%JegB)) < 0.1)) then - OBC_mask_v(i,J) = .true. ; any_OBC = .true. - endif - enddo ; enddo - if (.not.any_OBC) then - ! This processor has no v points at which open boundary conditions are - ! to be applied. - apply_OBC_v = .false. - deallocate(OBC_mask_v) - endif - endif - - if (.not.(apply_OBC_u .or. apply_OBC_v)) return + if (.not.associated(OBC)) return + if (.not.(OBC%apply_OBC_u .or. OBC%apply_OBC_v)) return - if (.not.associated(OBC)) allocate(OBC) - - if (apply_OBC_u) then - OBC%apply_OBC_u = .true. - OBC%OBC_mask_u => OBC_mask_u + if (OBC%apply_OBC_u) then allocate(OBC%u(IsdB:IedB,jsd:jed,nz)) ; OBC%u(:,:,:) = 0.0 allocate(OBC%uh(IsdB:IedB,jsd:jed,nz)) ; OBC%uh(:,:,:) = 0.0 allocate(OBC%OBC_kind_u(IsdB:IedB,jsd:jed)) ; OBC%OBC_kind_u(:,:) = OBC_NONE @@ -346,9 +339,7 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) if (OBC%OBC_mask_u(I,j)) OBC%OBC_kind_u(I,j) = OBC_SIMPLE enddo ; enddo endif - if (apply_OBC_v) then - OBC%apply_OBC_v = .true. - OBC%OBC_mask_v => OBC_mask_v + if (OBC%apply_OBC_v) then allocate(OBC%v(isd:ied,JsdB:JedB,nz)) ; OBC%v(:,:,:) = 0.0 allocate(OBC%vh(isd:ied,JsdB:JedB,nz)) ; OBC%vh(:,:,:) = 0.0 allocate(OBC%OBC_kind_v(isd:ied,JsdB:JedB)) ; OBC%OBC_kind_v(:,:) = OBC_NONE @@ -357,7 +348,7 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) enddo ; enddo endif - if (apply_OBC_v) then + if (OBC%apply_OBC_v) then g_prime_tot = (G%g_Earth/GV%Rho0)*2.0 Def_Rad = sqrt(D_edge*g_prime_tot) / (1.0e-4*1000.0) tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*Def_Rad) * GV%m_to_H @@ -380,7 +371,7 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) if (k == nz) tr_k = tr_k + tr_0 * (2.0/(Ri_trans*(2.0+Ri_trans))) * & log((2.0+Ri_trans)/(2.0-Ri_trans)) do J=JsdB,JedB ; do i=isd,ied - if (OBC_mask_v(i,J)) then + if (OBC%OBC_mask_v(i,J)) then ! This needs to be unneccesarily complicated without symmetric memory. lon_im1 = 2.0*G%geoLonCv(i,J) - G%geoLonBu(I,J) ! if (isd > IsdB) lon_im1 = G%geoLonBu(I-1,J) @@ -394,9 +385,9 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) enddo endif - if (apply_OBC_u) then + if (OBC%apply_OBC_u) then do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB - if (OBC_mask_u(I,j)) then + if (OBC%OBC_mask_u(I,j)) then ! An appropriate expression for the zonal inflow velocities and ! transports should go here. OBC%uh(I,j,k) = 0.0 * GV%m_to_H ; OBC%u(I,j,k) = 0.0 @@ -408,7 +399,7 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) ! The inflow values of temperature and salinity also need to be set here if ! these variables are used. The following code is just a naive example. - if (apply_OBC_u .or. apply_OBC_v) then + if (OBC%apply_OBC_u .or. OBC%apply_OBC_v) then if (associated(tv%S)) then ! In this example, all S inflows have values of 35 psu. call add_tracer_OBC_values("S", tr_Reg, OBC_inflow=35.0) @@ -428,13 +419,13 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) do k=1,nz ; T0(k) = T0(k) + (GV%Rlay(k)-rho_guess(k)) / drho_dT(k) ; enddo enddo - if (apply_OBC_u) then + if (OBC%apply_OBC_u) then allocate(OBC_T_u(IsdB:IedB,jsd:jed,nz)) do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB OBC_T_u(I,j,k) = T0(k) enddo ; enddo ; enddo endif - if (apply_OBC_v) then + if (OBC%apply_OBC_v) then allocate(OBC_T_v(isd:ied,JsdB:JedB,nz)) do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied OBC_T_v(i,J,k) = T0(k) @@ -445,8 +436,7 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) endif endif -end subroutine DOME_set_Open_Bdry_Conds -! ----------------------------------------------------------------------------- +end subroutine DOME_set_OBC_data !> \class DOME_initialization !! From 2d3856f811041ab88b5368872c3db9630064dead Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 13 Jun 2016 20:42:18 -0400 Subject: [PATCH 07/33] Split out OBC positions in USER_initialization - As for commit 83e50eb0dfe8454a0431a079bf716c1bac9a9b37 the setting OBC masks and inflow data are now separated. - This commit is mostly a no-op since the USER_initialization module is blank and only provides example APIs. - This is one step in a larger re-factor of OBC code. --- .../MOM_state_initialization.F90 | 6 +++-- src/user/user_initialization.F90 | 25 ++++++++++++++++--- 2 files changed, 25 insertions(+), 6 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index fe310f51a3..7bda870db3 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -40,7 +40,8 @@ module MOM_state_initialization use MOM_EOS, only : int_specific_vol_dp use user_initialization, only : user_initialize_thickness, user_initialize_velocity use user_initialization, only : user_init_temperature_salinity -use user_initialization, only : user_set_Open_Bdry_Conds, user_initialize_sponges +use user_initialization, only : user_set_OBC_positions, user_set_OBC_data +use user_initialization, only : user_initialize_sponges use DOME_initialization, only : DOME_initialize_thickness use DOME_initialization, only : DOME_set_OBC_positions, DOME_set_OBC_data use DOME_initialization, only : DOME_initialize_sponges @@ -443,7 +444,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & call DOME_set_OBC_positions(G, PF, OBC) call DOME_set_OBC_data(OBC, tv, G, GV, PF, tracer_Reg) elseif (trim(config) == "USER") then - call user_set_Open_Bdry_Conds(OBC, tv, G, PF, tracer_Reg) + call user_set_OBC_positions(G, PF, OBC) + call user_set_OBC_data(OBC, tv, G, PF, tracer_Reg) else call MOM_error(FATAL, "The open boundary conditions specified by "//& "OBC_CONFIG = "//trim(config)//" have not been fully implemented.") diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 0364ef884c..33e1090617 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -40,7 +40,7 @@ module user_initialization public USER_set_coord, USER_initialize_topography, USER_initialize_thickness public USER_initialize_velocity, USER_init_temperature_salinity public USER_init_mixed_layer_density, USER_initialize_sponges -public USER_set_Open_Bdry_Conds, USER_set_rotation +public USER_set_OBC_positions, USER_set_OBC_data, USER_set_rotation logical :: first_call = .true. @@ -197,8 +197,25 @@ subroutine USER_initialize_sponges(G, use_temperature, tv, param_file, CSp, h) end subroutine USER_initialize_sponges +!> This subroutine sets the location of open boundaries. +subroutine USER_set_OBC_positions(G, param_file, OBC) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure indicating the + !! open file to parse for model + !! parameter values. + type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies + !! whether, where, and what open boundary + !! conditions are used. +! call MOM_error(FATAL, & +! "USER_initialization.F90, USER_set_OBC_positions: " // & +! "Unmodified user routine called - you must edit the routine to use it") + + if (first_call) call write_user_log(param_file) + +end subroutine USER_set_OBC_positions + !> This subroutine sets the properties of flow at open boundary conditions. -subroutine USER_set_Open_Bdry_Conds(OBC, tv, G, param_file, tr_Reg) +subroutine USER_set_OBC_data(OBC, tv, G, param_file, tr_Reg) type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. @@ -212,12 +229,12 @@ subroutine USER_set_Open_Bdry_Conds(OBC, tv, G, param_file, tr_Reg) !! parameter values. type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry. ! call MOM_error(FATAL, & -! "USER_initialization.F90, USER_set_Open_Bdry_Conds: " // & +! "USER_initialization.F90, USER_set_OBC_data: " // & ! "Unmodified user routine called - you must edit the routine to use it") if (first_call) call write_user_log(param_file) -end subroutine USER_set_Open_Bdry_Conds +end subroutine USER_set_OBC_data subroutine USER_set_rotation(G, param_file) type(ocean_grid_type), intent(inout) :: G From d5efae284df5f1c7d92bde2e1736b1d49f0a5b67 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 13 Jun 2016 22:11:09 -0400 Subject: [PATCH 08/33] Moved calls that set OBC masks into MOM_fixed_initialization - Prior to this commit, OBC masks were set at the same time as OBC inflow data was set, and all called from MOM_state_initialization, which is too late to correct bathymetry etc. - This is part of a larger OBC re-factor. - No answer changes. --- src/core/MOM.F90 | 2 +- .../MOM_fixed_initialization.F90 | 37 +++++++++++++++++-- .../MOM_state_initialization.F90 | 10 +---- 3 files changed, 35 insertions(+), 14 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 3221d0371d..c2156d9cbf 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1785,7 +1785,7 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call callTree_waypoint("restart registration complete (initialize_MOM)") call cpu_clock_begin(id_clock_MOM_init) - call MOM_initialize_fixed(G, param_file, write_geom_files, dirs%output_directory) + call MOM_initialize_fixed(G, CS%OBC, param_file, write_geom_files, dirs%output_directory) call callTree_waypoint("returned from MOM_initialize_fixed() (initialize_MOM)") call MOM_initialize_coord(GV, param_file, write_geom_files, & dirs%output_directory, CS%tv, G%max_depth) diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 5ebe25a844..1d762e7376 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -18,9 +18,10 @@ module MOM_fixed_initialization use MOM_io, only : slasher, vardesc, write_field, var_desc use MOM_io, only : EAST_FACE, NORTH_FACE use MOM_grid_initialize, only : initialize_masks, set_grid_metrics +use MOM_open_boundary, only : ocean_OBC_type use MOM_string_functions, only : uppercase -use user_initialization, only : user_initialize_topography -use DOME_initialization, only : DOME_initialize_topography +use user_initialization, only : user_initialize_topography, USER_set_OBC_positions +use DOME_initialization, only : DOME_initialize_topography, DOME_set_OBC_positions use ISOMIP_initialization, only : ISOMIP_initialize_topography use benchmark_initialization, only : benchmark_initialize_topography use DOME2d_initialization, only : DOME2d_initialize_topography @@ -43,8 +44,9 @@ module MOM_fixed_initialization ! ----------------------------------------------------------------------------- !> MOM_initialize_fixed sets up time-invariant quantities related to MOM6's !! horizontal grid, bathymetry, and the Coriolis parameter. -subroutine MOM_initialize_fixed(G, PF, write_geom, output_dir) +subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure. type(param_file_type), intent(in) :: PF !< A structure indicating the open file !! to parse for model parameter values. logical, intent(in) :: write_geom !< If true, write grid geometry files. @@ -53,7 +55,7 @@ subroutine MOM_initialize_fixed(G, PF, write_geom, output_dir) ! Local character(len=200) :: inputdir ! The directory where NetCDF input files are. character(len=200) :: config - logical :: debug + logical :: debug, apply_OBC_u, apply_OBC_v ! This include declares and sets the variable "version". #include "version_variable.h" @@ -78,6 +80,33 @@ subroutine MOM_initialize_fixed(G, PF, write_geom, output_dir) ! masks, and Coriolis parameter. ! ==================================================================== +! Determine the position of any open boundaries + call get_param(PF, mod, "APPLY_OBC_U", apply_OBC_u, & + "If true, open boundary conditions may be set at some \n"//& + "u-points, with the configuration controlled by OBC_CONFIG", & + default=.false.) + call get_param(PF, mod, "APPLY_OBC_V", apply_OBC_v, & + "If true, open boundary conditions may be set at some \n"//& + "v-points, with the configuration controlled by OBC_CONFIG", & + default=.false.) + if (apply_OBC_u .or. apply_OBC_v) then + call get_param(PF, mod, "OBC_CONFIG", config, & + "A string that sets how the open boundary conditions are \n"//& + " configured: \n"//& + " \t DOME - use a slope and channel configuration for the \n"//& + " \t\t DOME sill-overflow test case. \n"//& + " \t USER - call a user modified routine.", default="file", & + fail_if_missing=.true.) + select case ( trim(config) ) + case ("none") + case ("DOME") ; call DOME_set_OBC_positions(G, PF, OBC) + case ("USER") ; call user_set_OBC_positions(G, PF, OBC) + case default ; call MOM_error(FATAL, "MOM_initialize_fixed: "// & + "The open boundary positions specified by OBC_CONFIG="//& + trim(config)//" have not been fully implemented.") + end select + endif + ! This call sets seamasks that prohibit flow over any point with ! ! a bottom that is shallower than min_depth from PF. ! call initialize_masks(G, PF) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 7bda870db3..a846988fde 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -433,18 +433,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & "v-points, with the configuration controlled by OBC_CONFIG", & default=.false.) if (apply_OBC_u .or. apply_OBC_v) then - call get_param(PF, mod, "OBC_CONFIG", config, & - "A string that sets how the open boundary conditions are \n"//& - " configured: \n"//& - " \t DOME - use a slope and channel configuration for the \n"//& - " \t\t DOME sill-overflow test case. \n"//& - " \t USER - call a user modified routine.", default="file", & - fail_if_missing=.true.) + call get_param(PF, mod, "OBC_CONFIG", config, fail_if_missing=.true., do_not_log=.true.) if (trim(config) == "DOME") then - call DOME_set_OBC_positions(G, PF, OBC) call DOME_set_OBC_data(OBC, tv, G, GV, PF, tracer_Reg) elseif (trim(config) == "USER") then - call user_set_OBC_positions(G, PF, OBC) call user_set_OBC_data(OBC, tv, G, PF, tracer_Reg) else call MOM_error(FATAL, "The open boundary conditions specified by "//& From c90bec4c9438237e05fc2e80e5a49ebe9a75322d Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Mon, 13 Jun 2016 23:35:02 -0400 Subject: [PATCH 09/33] Moved allocation of OBC type to MOM_open_boundary - Previously, allocation of the OBC type was handled in user code rather than centrally. This meant duplication and inconsistent get_param for the controlling run-time parameters. - I've created an open_boundary_config() that allocates and reads the main run-time parameters that can be called from MOM_fixed_init. - To keep things succinct there is also now an open_boundary_query() that return true if collections of flags were set. - No answer changes. --- src/core/MOM_open_boundary.F90 | 120 ++++++++++++------ .../MOM_fixed_initialization.F90 | 14 +- src/user/DOME_initialization.F90 | 12 +- 3 files changed, 88 insertions(+), 58 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 1e769046e5..c7196fe710 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -12,7 +12,9 @@ module MOM_open_boundary #include +public open_boundary_config public open_boundary_init +public open_boundary_query public open_boundary_end public Radiation_Open_Bdry_Conds @@ -88,60 +90,102 @@ module MOM_open_boundary contains -!> Initialize open boundary control structure -subroutine open_boundary_init(Time, G, param_file, diag, OBC) - type(time_type), target, intent(in) :: Time !< Current model time +!> Enables OBC module and reads configuration parameters +subroutine open_boundary_config(G, param_file, OBC) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(param_file_type), intent(in) :: param_file !< Parameter file handle - type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure ! Local variables logical :: flather_east, flather_west, flather_north, flather_south + allocate(OBC) + call log_version(param_file, mod, version) - call get_param(param_file, mod, "APPLY_OBC_U_FLATHER_EAST", flather_east, & - "If true, some zonal velocity points use Flather open \n"//& - "boundary conditions on the east side of the ocean.", & + call get_param(param_file, mod, "APPLY_OBC_U", OBC%apply_OBC_u, & + "If true, open boundary conditions may be set at some \n"//& + "u-points, with the configuration controlled by OBC_CONFIG", & + default=.false.) + call get_param(param_file, mod, "APPLY_OBC_V", OBC%apply_OBC_v, & + "If true, open boundary conditions may be set at some \n"//& + "v-points, with the configuration controlled by OBC_CONFIG", & default=.false.) - call get_param(param_file, mod, "APPLY_OBC_U_FLATHER_WEST", flather_west, & - "If true, some zonal velocity points use Flather open \n"//& - "boundary conditions on the west side of the ocean.", & + call get_param(param_file, mod, "APPLY_OBC_U_FLATHER_EAST", OBC%apply_OBC_u_flather_east, & + "Apply a Flather open boundary condition on the eastern\n"//& + "side of the global domain", & default=.false.) - call get_param(param_file, mod, "APPLY_OBC_V_FLATHER_NORTH", flather_north, & - "If true, some meridional velocity points use Flather \n"//& - "open boundary conditions on the north side of the ocean.", & + call get_param(param_file, mod, "APPLY_OBC_U_FLATHER_WEST", OBC%apply_OBC_u_flather_west, & + "Apply a Flather open boundary condition on the western\n"//& + "side of the global domain", & default=.false.) - call get_param(param_file, mod, "APPLY_OBC_V_FLATHER_SOUTH", flather_south, & - "If true, some meridional velocity points use Flather \n"//& - "open boundary conditions on the north side of the ocean.", & + call get_param(param_file, mod, "APPLY_OBC_V_FLATHER_NORTH", OBC%apply_OBC_v_flather_north, & + "Apply a Flather open boundary condition on the northern\n"//& + "side of the global domain", & default=.false.) - if (.not.(flather_east .or. flather_west .or. flather_north .or. & - flather_south)) return - - call get_param(param_file, mod, "OBC_RADIATION_MAX", OBC%rx_max, & - "The maximum magnitude of the baroclinic radiation \n"//& - "velocity (or speed of characteristics). This is only \n"//& - "used if one of the APPLY_OBC_[UV]_FLATHER_... is true.", & - units="m s-1", default=10.0) - call get_param(param_file, mod, "OBC_RAD_VEL_WT", OBC%gamma_uv, & - "The relative weighting for the baroclinic radiation \n"//& - "velocities (or speed of characteristics) at the new \n"//& - "time level (1) or the running mean (0) for velocities. \n"//& - "Valid values range from 0 to 1. This is only used if \n"//& - "one of the APPLY_OBC_[UV]_FLATHER_... is true.", & - units="nondim", default=0.3) - call get_param(param_file, mod, "OBC_RAD_THICK_WT", OBC%gamma_h, & - "The relative weighting for the baroclinic radiation \n"//& - "velocities (or speed of characteristics) at the new \n"//& - "time level (1) or the running mean (0) for thicknesses. \n"//& - "Valid values range from 0 to 1. This is only used if \n"//& - "one of the APPLY_OBC_[UV]_FLATHER_... is true.", & - units="nondim", default=0.2) + call get_param(param_file, mod, "APPLY_OBC_V_FLATHER_SOUTH", OBC%apply_OBC_v_flather_south, & + "Apply a Flather open boundary condition on the southern\n"//& + "side of the global domain", & + default=.false.) + if (.not.(OBC%apply_OBC_u .or. OBC%apply_OBC_v .or. & + OBC%apply_OBC_v_flather_north .or. OBC%apply_OBC_v_flather_south .or. & + OBC%apply_OBC_u_flather_east .or. OBC%apply_OBC_u_flather_west)) then + ! No open boundaries have been requested + deallocate(OBC) + endif + +end subroutine open_boundary_config + +!> Initialize open boundary control structure +subroutine open_boundary_init(Time, G, param_file, diag, OBC) + type(time_type), target, intent(in) :: Time !< Current model time + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(param_file_type), intent(in) :: param_file !< Parameter file handle + type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + ! Local variables + + if (.not.associated(OBC)) return + + if ( OBC%apply_OBC_v_flather_north .or. OBC%apply_OBC_v_flather_south .or. & + OBC%apply_OBC_u_flather_east .or. OBC%apply_OBC_u_flather_west ) then + call get_param(param_file, mod, "OBC_RADIATION_MAX", OBC%rx_max, & + "The maximum magnitude of the baroclinic radiation \n"//& + "velocity (or speed of characteristics). This is only \n"//& + "used if one of the APPLY_OBC_[UV]_FLATHER_... is true.", & + units="m s-1", default=10.0) + call get_param(param_file, mod, "OBC_RAD_VEL_WT", OBC%gamma_uv, & + "The relative weighting for the baroclinic radiation \n"//& + "velocities (or speed of characteristics) at the new \n"//& + "time level (1) or the running mean (0) for velocities. \n"//& + "Valid values range from 0 to 1. This is only used if \n"//& + "one of the APPLY_OBC_[UV]_FLATHER_... is true.", & + units="nondim", default=0.3) + call get_param(param_file, mod, "OBC_RAD_THICK_WT", OBC%gamma_h, & + "The relative weighting for the baroclinic radiation \n"//& + "velocities (or speed of characteristics) at the new \n"//& + "time level (1) or the running mean (0) for thicknesses. \n"//& + "Valid values range from 0 to 1. This is only used if \n"//& + "one of the APPLY_OBC_[UV]_FLATHER_... is true.", & + units="nondim", default=0.2) + endif id_clock_pass = cpu_clock_id('(Ocean OBC halo updates)', grain=CLOCK_ROUTINE) end subroutine open_boundary_init +!> Query the state of open boundary module configuration +logical function open_boundary_query(OBC, apply_orig_OBCs, apply_orig_Flather) + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + logical, optional, intent(in) :: apply_orig_OBCs !< If present, returns True if APPLY_OBC_U/V was set + logical, optional, intent(in) :: apply_orig_Flather !< If present, returns True if APPLY_OBC_*_FLATHER_* was set + open_boundary_query = .false. + if (.not. associated(OBC)) return + if (present(apply_orig_OBCs)) open_boundary_query = OBC%apply_OBC_u .or. OBC%apply_OBC_v + if (present(apply_orig_Flather)) open_boundary_query = OBC%apply_OBC_v_flather_north .or. & + OBC%apply_OBC_v_flather_south .or. & + OBC%apply_OBC_u_flather_east .or. & + OBC%apply_OBC_u_flather_west +end function open_boundary_query + !> Deallocate open boundary data subroutine open_boundary_end(OBC) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 1d762e7376..175bc2d076 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -19,6 +19,7 @@ module MOM_fixed_initialization use MOM_io, only : EAST_FACE, NORTH_FACE use MOM_grid_initialize, only : initialize_masks, set_grid_metrics use MOM_open_boundary, only : ocean_OBC_type +use MOM_open_boundary, only : open_boundary_config, open_boundary_query use MOM_string_functions, only : uppercase use user_initialization, only : user_initialize_topography, USER_set_OBC_positions use DOME_initialization, only : DOME_initialize_topography, DOME_set_OBC_positions @@ -55,7 +56,7 @@ subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir) ! Local character(len=200) :: inputdir ! The directory where NetCDF input files are. character(len=200) :: config - logical :: debug, apply_OBC_u, apply_OBC_v + logical :: debug ! This include declares and sets the variable "version". #include "version_variable.h" @@ -81,15 +82,8 @@ subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir) ! ==================================================================== ! Determine the position of any open boundaries - call get_param(PF, mod, "APPLY_OBC_U", apply_OBC_u, & - "If true, open boundary conditions may be set at some \n"//& - "u-points, with the configuration controlled by OBC_CONFIG", & - default=.false.) - call get_param(PF, mod, "APPLY_OBC_V", apply_OBC_v, & - "If true, open boundary conditions may be set at some \n"//& - "v-points, with the configuration controlled by OBC_CONFIG", & - default=.false.) - if (apply_OBC_u .or. apply_OBC_v) then + call open_boundary_config(G, PF, OBC) + if (open_boundary_query(OBC, apply_orig_OBCs=.true.)) then call get_param(PF, mod, "OBC_CONFIG", config, & "A string that sets how the open boundary conditions are \n"//& " configured: \n"//& diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 455cb559c5..ed0ad2eb98 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -242,16 +242,8 @@ subroutine DOME_set_OBC_positions(G, param_file, OBC) integer :: i, j logical :: any_OBC ! Set to true if any points in this subdomain use OBCs - if (.not.associated(OBC)) allocate(OBC) - - call get_param(param_file, mod, "APPLY_OBC_U", OBC%apply_OBC_u, & - "If true, open boundary conditions may be set at some \n"//& - "u-points, with the configuration controlled by OBC_CONFIG", & - default=.false.) - call get_param(param_file, mod, "APPLY_OBC_V", OBC%apply_OBC_v, & - "If true, open boundary conditions may be set at some \n"//& - "v-points, with the configuration controlled by OBC_CONFIG", & - default=.false.) + if (.not.associated(OBC)) call MOM_error(FATAL, & + "DOME_initialization, DOME_set_OBC_positions: OBC type was not allocated!") any_OBC = .false. if (OBC%apply_OBC_u) then From 59c567640c355279bc33cdde5f5f02c881a7b51c Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 14 Jun 2016 00:17:09 -0400 Subject: [PATCH 10/33] Moved set_Flather_Bdry_Conds() into MOM_open_boundary - The initialization routine set_Flather_Bdry_Conds() now lives in MOM_open_boundary.F90, so that we can later split it into fixed and state related parts. - This is part of a larger re-factor of OBC code. - No answer changes. --- src/core/MOM_open_boundary.F90 | 323 ++++++++++++++- .../MOM_state_initialization.F90 | 386 +----------------- 2 files changed, 326 insertions(+), 383 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index c7196fe710..400c414698 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -4,9 +4,14 @@ module MOM_open_boundary use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_domains, only : pass_var, pass_vector +use MOM_domains, only : To_All, SCALAR_PAIR, CGRID_NE use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_file_parser, only : get_param, log_version, param_file_type, log_param use MOM_grid, only : ocean_grid_type +use MOM_io, only : EAST_FACE, NORTH_FACE +use MOM_io, only : slasher, read_data +use MOM_tracer_registry, only : add_tracer_OBC_values, tracer_registry_type +use MOM_variables, only : thermo_var_ptrs implicit none ; private @@ -17,6 +22,7 @@ module MOM_open_boundary public open_boundary_query public open_boundary_end public Radiation_Open_Bdry_Conds +public set_Flather_Bdry_Conds integer, parameter, public :: OBC_NONE = 0, OBC_SIMPLE = 1, OBC_WALL = 2 integer, parameter, public :: OBC_FLATHER_E = 4, OBC_FLATHER_W = 5 @@ -306,6 +312,321 @@ subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & end subroutine Radiation_Open_Bdry_Conds +!> Sets the initial definitions of the characteristic open boundary conditions. +!! \author Mehmet Ilicak +subroutine set_Flather_Bdry_Conds(OBC, tv, h, G, PF, tracer_Reg) + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(inout) :: h !< Thickness + type(param_file_type), intent(in) :: PF !< Parameter file handle + type(tracer_registry_type), pointer :: tracer_Reg !< Tracer registry + ! Local variables + logical :: read_OBC_eta = .false. + logical :: read_OBC_uv = .false. + logical :: read_OBC_TS = .false. + integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, nz + integer :: isd_off, jsd_off + integer :: IsdB, IedB, JsdB, JedB + integer :: east_boundary, west_boundary, north_boundary, south_boundary + character(len=40) :: mod = "set_Flather_Bdry_Conds" ! This subroutine's name. + character(len=200) :: filename, OBC_file, inputdir ! Strings for file/path + + real :: temp_u(G%domain%niglobal+1,G%domain%njglobal) + real :: temp_v(G%domain%niglobal,G%domain%njglobal+1) + + real, pointer, dimension(:,:,:) :: & + OBC_T_u => NULL(), & ! These arrays should be allocated and set to + OBC_T_v => NULL(), & ! specify the values of T and S that should come + OBC_S_u => NULL(), & + OBC_S_v => NULL() + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%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 + + call get_param(PF, mod, "READ_OBC_UV", read_OBC_uv, & + "If true, read the values for the velocity open boundary \n"//& + "conditions from the file specified by OBC_FILE.", & + default=.false.) + call get_param(PF, mod, "READ_OBC_ETA", read_OBC_eta, & + "If true, read the values for the sea surface height \n"//& + "open boundary conditions from the file specified by \n"//& + "OBC_FILE.", default=.false.) + call get_param(PF, mod, "READ_OBC_TS", read_OBC_TS, & + "If true, read the values for the temperature and \n"//& + "salinity open boundary conditions from the file \n"//& + "specified by OBC_FILE.", default=.false.) + if (read_OBC_uv .or. read_OBC_eta .or. read_OBC_TS) then + call get_param(PF, mod, "OBC_FILE", OBC_file, & + "The file from which the appropriate open boundary \n"//& + "condition values are read.", default="MOM_OBC_FILE.nc") + call get_param(PF, mod, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) + filename = trim(inputdir)//trim(OBC_file) + call log_param(PF, mod, "INPUTDIR/OBC_FILE", filename) + endif + + if (G%symmetric) then + east_boundary = G%ieg + west_boundary = G%isg-1 + north_boundary = G%jeg + south_boundary = G%jsg-1 + else + ! I am not entirely sure that this works properly. -RWH + east_boundary = G%ieg-1 + west_boundary = G%isg + north_boundary = G%jeg-1 + south_boundary = G%jsg + endif + + if (.not.associated(OBC%OBC_mask_u)) then + allocate(OBC%OBC_mask_u(IsdB:IedB,jsd:jed)) ; OBC%OBC_mask_u(:,:) = .false. + endif + if (.not.associated(OBC%OBC_kind_u)) then + allocate(OBC%OBC_kind_u(IsdB:IedB,jsd:jed)) ; OBC%OBC_kind_u(:,:) = OBC_NONE + endif + if (.not.associated(OBC%OBC_mask_v)) then + allocate(OBC%OBC_mask_v(isd:ied,JsdB:JedB)) ; OBC%OBC_mask_v(:,:) = .false. + endif + if (.not.associated(OBC%OBC_kind_v)) then + allocate(OBC%OBC_kind_v(isd:ied,JsdB:JedB)) ; OBC%OBC_kind_v(:,:) = OBC_NONE + endif + + if (.not.associated(OBC%vbt_outer)) then + allocate(OBC%vbt_outer(isd:ied,JsdB:JedB)) ; OBC%vbt_outer(:,:) = 0.0 + endif + + if (.not.associated(OBC%ubt_outer)) then + allocate(OBC%ubt_outer(IsdB:IedB,jsd:jed)) ; OBC%ubt_outer(:,:) = 0.0 + endif + + if (.not.associated(OBC%eta_outer_u)) then + allocate(OBC%eta_outer_u(IsdB:IedB,jsd:jed)) ; OBC%eta_outer_u(:,:) = 0.0 + endif + + if (.not.associated(OBC%eta_outer_v)) then + allocate(OBC%eta_outer_v(isd:ied,JsdB:JedB)) ; OBC%eta_outer_v(:,:) = 0.0 + endif + + if (read_OBC_uv) then + call read_data(filename, 'ubt', OBC%ubt_outer, & + domain=G%Domain%mpp_domain, position=EAST_FACE) + call read_data(filename, 'vbt', OBC%vbt_outer, & + domain=G%Domain%mpp_domain, position=NORTH_FACE) + endif + + if (read_OBC_eta) then + call read_data(filename, 'eta_outer_u', OBC%eta_outer_u, & + domain=G%Domain%mpp_domain, position=EAST_FACE) + call read_data(filename, 'eta_outer_v', OBC%eta_outer_v, & + domain=G%Domain%mpp_domain, position=NORTH_FACE) + endif + + call pass_vector(OBC%eta_outer_u,OBC%eta_outer_v,G%Domain, To_All+SCALAR_PAIR, CGRID_NE) + call pass_vector(OBC%ubt_outer,OBC%vbt_outer,G%Domain) + + ! This code should be modified to allow OBCs to be applied anywhere. + + if (OBC%apply_OBC_u_flather_east) then + ! Determine where u points are applied at east side + do j=jsd,jed ; do I=IsdB,IedB + if ((I+G%idg_offset) == east_boundary) then !eastern side + if (G%mask2dCu(I,j) > 0.50) then + OBC%OBC_mask_u(I,j) = .true. + OBC%OBC_kind_u(I,j) = OBC_FLATHER_E + if (G%mask2dCv(i+1,J) > 0.50) then + OBC%OBC_mask_v(i+1,J) = .true. + if (OBC%OBC_kind_v(i+1,J) == OBC_NONE) OBC%OBC_kind_v(i+1,J) = OBC_FLATHER_E + endif + if (G%mask2dCv(i+1,J-1) > 0.50) then + OBC%OBC_mask_v(i+1,J-1) = .true. + if (OBC%OBC_kind_v(i+1,J-1) == OBC_NONE) OBC%OBC_kind_v(i+1,J-1) = OBC_FLATHER_E + endif + endif + endif + enddo ; enddo + endif + + if (OBC%apply_OBC_u_flather_west) then + ! Determine where u points are applied at west side + do j=jsd,jed ; do I=IsdB,IedB + if ((I+G%idg_offset) == west_boundary) then !western side + if (G%mask2dCu(I,j) > 0.50) then + OBC%OBC_mask_u(I,j) = .true. + OBC%OBC_kind_u(I,j) = OBC_FLATHER_W + if (G%mask2dCv(i,J) > 0.50) then + OBC%OBC_mask_v(i,J) = .true. + if (OBC%OBC_kind_v(i,J) == OBC_NONE) OBC%OBC_kind_v(i,J) = OBC_FLATHER_W + endif + if (G%mask2dCv(i,J-1) > 0.50) then + OBC%OBC_mask_v(i,J-1) = .true. + if (OBC%OBC_kind_v(i,J-1) == OBC_NONE) OBC%OBC_kind_v(i,J-1) = OBC_FLATHER_W + endif + endif + endif + enddo ; enddo + endif + + + if (OBC%apply_OBC_v_flather_north) then + ! Determine where v points are applied at north side + do J=JsdB,JedB ; do i=isd,ied + if ((J+G%jdg_offset) == north_boundary) then !northern side + if (G%mask2dCv(i,J) > 0.50) then + OBC%OBC_mask_v(i,J) = .true. + OBC%OBC_kind_v(i,J) = OBC_FLATHER_N + if (G%mask2dCu(I,j+1) > 0.50) then + OBC%OBC_mask_u(I,j+1) = .true. + if (OBC%OBC_kind_u(I,j+1) == OBC_NONE) OBC%OBC_kind_u(I,j+1) = OBC_FLATHER_N + endif + if (G%mask2dCu(I-1,j+1) > 0.50) then + OBC%OBC_mask_u(I-1,j+1) = .true. + if (OBC%OBC_kind_u(I-1,j+1) == OBC_NONE) OBC%OBC_kind_u(I-1,j+1) = OBC_FLATHER_N + endif + endif + endif + enddo ; enddo + endif + + if (OBC%apply_OBC_v_flather_south) then + ! Determine where v points are applied at south side + do J=JsdB,JedB ; do i=isd,ied + if ((J+G%jdg_offset) == south_boundary) then !southern side + if (G%mask2dCv(i,J) > 0.50) then + OBC%OBC_mask_v(i,J) = .true. + OBC%OBC_kind_v(i,J) = OBC_FLATHER_S + if (G%mask2dCu(I,j) > 0.50) then + OBC%OBC_mask_u(I,j) = .true. + if (OBC%OBC_kind_u(I,j) == OBC_NONE) OBC%OBC_kind_u(I,j) = OBC_FLATHER_S + endif + if (G%mask2dCu(I-1,j) > 0.50) then + OBC%OBC_mask_u(I-1,j) = .true. + if (OBC%OBC_kind_u(I-1,j) == OBC_NONE) OBC%OBC_kind_u(I-1,j) = OBC_FLATHER_S + endif + endif + endif + enddo ; enddo + endif + + ! If there are no OBC points on this PE, there is no reason to keep the OBC + ! type, and it could be deallocated. + + + ! Define radiation coefficients r[xy]_old_[uvh] as needed. For now, there are + ! no radiation conditions applied to the thicknesses, since the thicknesses + ! might not be physically motivated. Instead, sponges should be used to + ! enforce the near-boundary layer structure. + if (OBC%apply_OBC_u_flather_west .or. OBC%apply_OBC_u_flather_east) then + allocate(OBC%rx_old_u(IsdB:IedB,jsd:jed,nz)) ; OBC%rx_old_u(:,:,:) = 0.0 + ! allocate(OBC%rx_old_h(Isd:Ied,jsd:jed,nz)) ; OBC%rx_old_h(:,:,:) = 0.0 + endif + if (OBC%apply_OBC_v_flather_south .or. OBC%apply_OBC_v_flather_north) then + allocate(OBC%ry_old_v(isd:ied,JsdB:JedB,nz)) ; OBC%ry_old_v(:,:,:) = 0.0 + ! allocate(OBC%ry_old_h(isd:ied,Jsd:Jed,nz)) ; OBC%ry_old_h(:,:,:) = 0.0 + endif + + + if (associated(tv%T)) then + allocate(OBC_T_u(IsdB:IedB,jsd:jed,nz)) ; OBC_T_u(:,:,:) = 0.0 + allocate(OBC_S_u(IsdB:IedB,jsd:jed,nz)) ; OBC_S_u(:,:,:) = 0.0 + allocate(OBC_T_v(isd:ied,JsdB:JedB,nz)) ; OBC_T_v(:,:,:) = 0.0 + allocate(OBC_S_v(isd:ied,JsdB:JedB,nz)) ; OBC_S_v(:,:,:) = 0.0 + + if (read_OBC_TS) then + call read_data(filename, 'OBC_T_u', OBC_T_u, & + domain=G%Domain%mpp_domain, position=EAST_FACE) + call read_data(filename, 'OBC_S_u', OBC_S_u, & + domain=G%Domain%mpp_domain, position=EAST_FACE) + + call read_data(filename, 'OBC_T_v', OBC_T_v, & + domain=G%Domain%mpp_domain, position=NORTH_FACE) + call read_data(filename, 'OBC_S_v', OBC_S_v, & + domain=G%Domain%mpp_domain, position=NORTH_FACE) + else + call pass_var(tv%T, G%Domain) + call pass_var(tv%S, G%Domain) + do k=1,nz ; do j=js,je ; do I=is-1,ie + if (OBC%OBC_mask_u(I,j)) then + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) then + OBC_T_u(I,j,k) = tv%T(i,j,k) + OBC_S_u(I,j,k) = tv%S(i,j,k) + elseif (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) then + OBC_T_u(I,j,k) = tv%T(i+1,j,k) + OBC_S_u(I,j,k) = tv%S(i+1,j,k) + elseif (G%mask2dT(i,j) + G%mask2dT(i+1,j) > 0) then + OBC_T_u(I,j,k) = (G%mask2dT(i,j)*tv%T(i,j,k) + G%mask2dT(i+1,j)*tv%T(i+1,j,k)) / & + (G%mask2dT(i,j) + G%mask2dT(i+1,j)) + OBC_S_u(I,j,k) = (G%mask2dT(i,j)*tv%S(i,j,k) + G%mask2dT(i+1,j)*tv%S(i+1,j,k)) / & + (G%mask2dT(i,j) + G%mask2dT(i+1,j)) + else ! This probably shouldn't happen or maybe it doesn't matter? + OBC_T_u(I,j,k) = 0.5*(tv%T(i,j,k)+tv%T(i+1,j,k)) + OBC_S_u(I,j,k) = 0.5*(tv%S(i,j,k)+tv%S(i+1,j,k)) + endif + else + OBC_T_u(I,j,k) = 0.5*(tv%T(i,j,k)+tv%T(i+1,j,k)) + OBC_S_u(I,j,k) = 0.5*(tv%S(i,j,k)+tv%S(i+1,j,k)) + endif + enddo; enddo ; enddo + + do k=1,nz ; do J=js-1,je ; do i=is,ie + if (OBC%OBC_mask_v(i,J)) then + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) then + OBC_T_v(i,J,k) = tv%T(i,j,k) + OBC_S_v(i,J,k) = tv%S(i,j,k) + elseif (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) then + OBC_T_v(i,J,k) = tv%T(i,j+1,k) + OBC_S_v(i,J,k) = tv%S(i,j+1,k) + elseif (G%mask2dT(i,j) + G%mask2dT(i,j+1) > 0) then + OBC_T_v(i,J,k) = (G%mask2dT(i,j)*tv%T(i,j,k) + G%mask2dT(i,j+1)*tv%T(i,j+1,k)) / & + (G%mask2dT(i,j) + G%mask2dT(i,j+1)) + OBC_S_v(i,J,k) = (G%mask2dT(i,j)*tv%S(i,j,k) + G%mask2dT(i,j+1)*tv%S(i,j+1,k)) / & + (G%mask2dT(i,j) + G%mask2dT(i,j+1)) + else ! This probably shouldn't happen or maybe it doesn't matter? + OBC_T_v(i,J,k) = 0.5*(tv%T(i,j,k)+tv%T(i,j+1,k)) + OBC_S_v(i,J,k) = 0.5*(tv%S(i,j,k)+tv%S(i,j+1,k)) + endif + else + OBC_T_v(i,J,k) = 0.5*(tv%T(i,j,k)+tv%T(i,j+1,k)) + OBC_S_v(i,J,k) = 0.5*(tv%S(i,j,k)+tv%S(i,j+1,k)) + endif + enddo; enddo ; enddo + endif + + call pass_vector(OBC_T_u, OBC_T_v, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) + call pass_vector(OBC_S_u, OBC_S_v, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) + + call add_tracer_OBC_values("T", tracer_Reg, OBC_in_u=OBC_T_u, & + OBC_in_v=OBC_T_v) + call add_tracer_OBC_values("S", tracer_Reg, OBC_in_u=OBC_S_u, & + OBC_in_v=OBC_S_v) + do k=1,nz ; do j=js,je ; do I=is-1,ie + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) then + tv%T(i+1,j,k) = tv%T(i,j,k) ; tv%S(i+1,j,k) = tv%S(i,j,k) + elseif (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) then + tv%T(i,j,k) = tv%T(i+1,j,k) ; tv%S(i,j,k) = tv%S(i+1,j,k) + endif + enddo ; enddo ; enddo + do k=1,nz ; do J=js-1,je ; do i=is,ie + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) then + tv%T(i,j+1,k) = tv%T(i,j,k) ; tv%S(i,j+1,k) = tv%S(i,j,k) + elseif (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) then + tv%T(i,j,k) = tv%T(i,j+1,k) ; tv%S(i,j,k) = tv%S(i,j+1,k) + endif + enddo ; enddo ; enddo + endif + + do k=1,nz ; do j=js-1,je+1 ; do I=is-1,ie+1 + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) h(i+1,j,k) = h(i,j,k) + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) h(i,j,k) = h(i+1,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=js-1,je+1 ; do i=is-1,ie+1 + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) h(i,j+1,k) = h(i,j,k) + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) h(i,j,k) = h(i,j+1,k) + enddo ; enddo ; enddo + +end subroutine set_Flather_Bdry_Conds + !> \namespace mom_open_boundary !! This module implements some aspects of internal open boundary !! conditions in MOM. diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index a846988fde..cf77120ee3 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -22,8 +22,8 @@ module MOM_state_initialization use MOM_io, only : slasher, vardesc, write_field use MOM_io, only : EAST_FACE, NORTH_FACE use MOM_open_boundary, only : ocean_OBC_type -use MOM_open_boundary, only : OBC_NONE, OBC_SIMPLE, OBC_FLATHER_E, OBC_FLATHER_W -use MOM_open_boundary, only : OBC_FLATHER_N, OBC_FLATHER_S +use MOM_open_boundary, only : OBC_NONE, OBC_SIMPLE +use MOM_open_boundary, only : open_boundary_query, set_Flather_Bdry_Conds use MOM_grid_initialize, only : initialize_masks, set_grid_metrics use MOM_restart, only : restore_state, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, set_up_sponge_ML_density @@ -142,9 +142,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & logical :: trim_ic_for_p_surf ! If true, remove the mass that would be displaced ! by a large surface pressure, such as with an ice sheet. logical :: Analytic_FV_PGF, obsol_test - logical :: apply_OBC_u, apply_OBC_v - logical :: apply_OBC_u_flather_east, apply_OBC_u_flather_west - logical :: apply_OBC_v_flather_north, apply_OBC_v_flather_south logical :: convert type(EOS_type), pointer :: eos => NULL() logical :: debug ! indicates whether to write debugging output @@ -424,15 +421,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & endif ! This subroutine call sets optional open boundary conditions. - call get_param(PF, mod, "APPLY_OBC_U", apply_OBC_u, & - "If true, open boundary conditions may be set at some \n"//& - "u-points, with the configuration controlled by OBC_CONFIG", & - default=.false.) - call get_param(PF, mod, "APPLY_OBC_V", apply_OBC_v, & - "If true, open boundary conditions may be set at some \n"//& - "v-points, with the configuration controlled by OBC_CONFIG", & - default=.false.) - if (apply_OBC_u .or. apply_OBC_v) then + if (open_boundary_query(OBC, apply_orig_OBCs=.true.)) then call get_param(PF, mod, "OBC_CONFIG", config, fail_if_missing=.true., do_not_log=.true.) if (trim(config) == "DOME") then call DOME_set_OBC_data(OBC, tv, G, GV, PF, tracer_Reg) @@ -445,19 +434,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & endif endif - call get_param(PF, mod, "APPLY_OBC_U_FLATHER_EAST", apply_OBC_u_flather_east,& - "Apply a Flather open boundary condition on the eastern \n"//& - "side of the global domain", default=.false.) - call get_param(PF, mod, "APPLY_OBC_U_FLATHER_WEST", apply_OBC_u_flather_west,& - "Apply a Flather open boundary condition on the western \n"//& - "side of the global domain", default=.false.) - call get_param(PF, mod, "APPLY_OBC_V_FLATHER_NORTH", apply_OBC_v_flather_north,& - "Apply a Flather open boundary condition on the northern \n"//& - "side of the global domain", default=.false.) - call get_param(PF, mod, "APPLY_OBC_V_FLATHER_SOUTH", apply_OBC_v_flather_south,& - "Apply a Flather open boundary condition on the southern \n"//& - "side of the global domain", default=.false.) - if (apply_OBC_u_flather_east .or. apply_OBC_u_flather_west .or. apply_OBC_v_flather_north .or. apply_OBC_v_flather_south) then + if (open_boundary_query(OBC, apply_orig_Flather=.true.)) then call set_Flather_Bdry_Conds(OBC, tv, h, G, PF, tracer_Reg) endif @@ -1660,361 +1637,6 @@ subroutine set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tracer_Reg) end subroutine set_Open_Bdry_Conds ! ----------------------------------------------------------------------------- -! ----------------------------------------------------------------------------- -subroutine set_Flather_Bdry_Conds(OBC, tv, h, G, PF, tracer_Reg) - type(ocean_grid_type), intent(inout) :: G - type(ocean_OBC_type), pointer :: OBC - type(thermo_var_ptrs), intent(inout) :: tv - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(inout) :: h - type(param_file_type), intent(in) :: PF - type(tracer_registry_type), pointer :: tracer_Reg -! This subroutine sets the initial definitions of the characteristic open boundary -! conditions. Written by Mehmet Ilicak - -! Arguments: OBC - This open boundary condition type specifies whether, where, -! and what open boundary conditions are used. -! (out) tv - A structure containing pointers to any available -! thermodynamic fields, including potential temperature and -! salinity or mixed layer density. Absent fields have NULL ptrs. -! (in) G - The ocean's grid structure. -! (in) PF - A structure indicating the open file to parse for -! model parameter values. - - logical :: any_OBC ! Set to true if any points in this subdomain use - ! open boundary conditions. - - logical :: apply_OBC_u_flather_east = .false., apply_OBC_u_flather_west = .false. - logical :: apply_OBC_v_flather_north = .false., apply_OBC_v_flather_south = .false. - logical :: read_OBC_eta = .false. - logical :: read_OBC_uv = .false. - logical :: read_OBC_TS = .false. - - integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, nz - integer :: isd_off, jsd_off - integer :: IsdB, IedB, JsdB, JedB - integer :: east_boundary, west_boundary, north_boundary, south_boundary - character(len=40) :: mod = "set_Flather_Bdry_Conds" ! This subroutine's name. - character(len=200) :: filename, OBC_file, inputdir ! Strings for file/path - - real :: temp_u(G%domain%niglobal+1,G%domain%njglobal) - real :: temp_v(G%domain%niglobal,G%domain%njglobal+1) - - real, pointer, dimension(:,:,:) :: & - OBC_T_u => NULL(), & ! These arrays should be allocated and set to - OBC_T_v => NULL(), & ! specify the values of T and S that should come - OBC_S_u => NULL(), & - OBC_S_v => NULL() - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%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 - - call get_param(PF, mod, "APPLY_OBC_U_FLATHER_EAST", apply_OBC_u_flather_east,& - "Apply a Flather open boundary condition on the eastern \n"//& - "side of the global domain", default=.false.) - call get_param(PF, mod, "APPLY_OBC_U_FLATHER_WEST", apply_OBC_u_flather_west,& - "Apply a Flather open boundary condition on the western \n"//& - "side of the global domain", default=.false.) - call get_param(PF, mod, "APPLY_OBC_V_FLATHER_NORTH", apply_OBC_v_flather_north,& - "Apply a Flather open boundary condition on the northern \n"//& - "side of the global domain", default=.false.) - call get_param(PF, mod, "APPLY_OBC_V_FLATHER_SOUTH", apply_OBC_v_flather_south,& - "Apply a Flather open boundary condition on the southern \n"//& - "side of the global domain", default=.false.) - - if (.not.(apply_OBC_u_flather_east .or. apply_OBC_u_flather_west .or. & - apply_OBC_v_flather_north .or. apply_OBC_v_flather_south)) return - - if (.not.associated(OBC)) allocate(OBC) - - OBC%apply_OBC_u_flather_east = apply_OBC_u_flather_east - OBC%apply_OBC_u_flather_west = apply_OBC_u_flather_west - OBC%apply_OBC_v_flather_north = apply_OBC_v_flather_north - OBC%apply_OBC_v_flather_south = apply_OBC_v_flather_south - - call get_param(PF, mod, "READ_OBC_UV", read_OBC_uv, & - "If true, read the values for the velocity open boundary \n"//& - "conditions from the file specified by OBC_FILE.", & - default=.false.) - call get_param(PF, mod, "READ_OBC_ETA", read_OBC_eta, & - "If true, read the values for the sea surface height \n"//& - "open boundary conditions from the file specified by \n"//& - "OBC_FILE.", default=.false.) - call get_param(PF, mod, "READ_OBC_TS", read_OBC_TS, & - "If true, read the values for the temperature and \n"//& - "salinity open boundary conditions from the file \n"//& - "specified by OBC_FILE.", default=.false.) - if (read_OBC_uv .or. read_OBC_eta .or. read_OBC_TS) then - call get_param(PF, mod, "OBC_FILE", OBC_file, & - "The file from which the appropriate open boundary \n"//& - "condition values are read.", default="MOM_OBC_FILE.nc") - call get_param(PF, mod, "INPUTDIR", inputdir, default=".") - inputdir = slasher(inputdir) - filename = trim(inputdir)//trim(OBC_file) - call log_param(PF, mod, "INPUTDIR/OBC_FILE", filename) - endif - - if (G%symmetric) then - east_boundary = G%ieg - west_boundary = G%isg-1 - north_boundary = G%jeg - south_boundary = G%jsg-1 - else - ! I am not entirely sure that this works properly. -RWH - east_boundary = G%ieg-1 - west_boundary = G%isg - north_boundary = G%jeg-1 - south_boundary = G%jsg - endif - - if (.not.associated(OBC%OBC_mask_u)) then - allocate(OBC%OBC_mask_u(IsdB:IedB,jsd:jed)) ; OBC%OBC_mask_u(:,:) = .false. - endif - if (.not.associated(OBC%OBC_kind_u)) then - allocate(OBC%OBC_kind_u(IsdB:IedB,jsd:jed)) ; OBC%OBC_kind_u(:,:) = OBC_NONE - endif - if (.not.associated(OBC%OBC_mask_v)) then - allocate(OBC%OBC_mask_v(isd:ied,JsdB:JedB)) ; OBC%OBC_mask_v(:,:) = .false. - endif - if (.not.associated(OBC%OBC_kind_v)) then - allocate(OBC%OBC_kind_v(isd:ied,JsdB:JedB)) ; OBC%OBC_kind_v(:,:) = OBC_NONE - endif - - if (.not.associated(OBC%vbt_outer)) then - allocate(OBC%vbt_outer(isd:ied,JsdB:JedB)) ; OBC%vbt_outer(:,:) = 0.0 - endif - - if (.not.associated(OBC%ubt_outer)) then - allocate(OBC%ubt_outer(IsdB:IedB,jsd:jed)) ; OBC%ubt_outer(:,:) = 0.0 - endif - - if (.not.associated(OBC%eta_outer_u)) then - allocate(OBC%eta_outer_u(IsdB:IedB,jsd:jed)) ; OBC%eta_outer_u(:,:) = 0.0 - endif - - if (.not.associated(OBC%eta_outer_v)) then - allocate(OBC%eta_outer_v(isd:ied,JsdB:JedB)) ; OBC%eta_outer_v(:,:) = 0.0 - endif - - if (read_OBC_uv) then - call read_data(filename, 'ubt', OBC%ubt_outer, & - domain=G%Domain%mpp_domain, position=EAST_FACE) - call read_data(filename, 'vbt', OBC%vbt_outer, & - domain=G%Domain%mpp_domain, position=NORTH_FACE) - endif - - if (read_OBC_eta) then - call read_data(filename, 'eta_outer_u', OBC%eta_outer_u, & - domain=G%Domain%mpp_domain, position=EAST_FACE) - call read_data(filename, 'eta_outer_v', OBC%eta_outer_v, & - domain=G%Domain%mpp_domain, position=NORTH_FACE) - endif - - call pass_vector(OBC%eta_outer_u,OBC%eta_outer_v,G%Domain, To_All+SCALAR_PAIR, CGRID_NE) - call pass_vector(OBC%ubt_outer,OBC%vbt_outer,G%Domain) - - ! This code should be modified to allow OBCs to be applied anywhere. - - if (apply_OBC_u_flather_east) then - ! Determine where u points are applied at east side - do j=jsd,jed ; do I=IsdB,IedB - if ((I+G%idg_offset) == east_boundary) then !eastern side - if (G%mask2dCu(I,j) > 0.50) then - OBC%OBC_mask_u(I,j) = .true. - OBC%OBC_kind_u(I,j) = OBC_FLATHER_E - if (G%mask2dCv(i+1,J) > 0.50) then - OBC%OBC_mask_v(i+1,J) = .true. - if (OBC%OBC_kind_v(i+1,J) == OBC_NONE) OBC%OBC_kind_v(i+1,J) = OBC_FLATHER_E - endif - if (G%mask2dCv(i+1,J-1) > 0.50) then - OBC%OBC_mask_v(i+1,J-1) = .true. - if (OBC%OBC_kind_v(i+1,J-1) == OBC_NONE) OBC%OBC_kind_v(i+1,J-1) = OBC_FLATHER_E - endif - endif - endif - enddo ; enddo - endif - - if (apply_OBC_u_flather_west) then - ! Determine where u points are applied at west side - do j=jsd,jed ; do I=IsdB,IedB - if ((I+G%idg_offset) == west_boundary) then !western side - if (G%mask2dCu(I,j) > 0.50) then - OBC%OBC_mask_u(I,j) = .true. - OBC%OBC_kind_u(I,j) = OBC_FLATHER_W - if (G%mask2dCv(i,J) > 0.50) then - OBC%OBC_mask_v(i,J) = .true. - if (OBC%OBC_kind_v(i,J) == OBC_NONE) OBC%OBC_kind_v(i,J) = OBC_FLATHER_W - endif - if (G%mask2dCv(i,J-1) > 0.50) then - OBC%OBC_mask_v(i,J-1) = .true. - if (OBC%OBC_kind_v(i,J-1) == OBC_NONE) OBC%OBC_kind_v(i,J-1) = OBC_FLATHER_W - endif - endif - endif - enddo ; enddo - endif - - - if (apply_OBC_v_flather_north) then - ! Determine where v points are applied at north side - do J=JsdB,JedB ; do i=isd,ied - if ((J+G%jdg_offset) == north_boundary) then !northern side - if (G%mask2dCv(i,J) > 0.50) then - OBC%OBC_mask_v(i,J) = .true. - OBC%OBC_kind_v(i,J) = OBC_FLATHER_N - if (G%mask2dCu(I,j+1) > 0.50) then - OBC%OBC_mask_u(I,j+1) = .true. - if (OBC%OBC_kind_u(I,j+1) == OBC_NONE) OBC%OBC_kind_u(I,j+1) = OBC_FLATHER_N - endif - if (G%mask2dCu(I-1,j+1) > 0.50) then - OBC%OBC_mask_u(I-1,j+1) = .true. - if (OBC%OBC_kind_u(I-1,j+1) == OBC_NONE) OBC%OBC_kind_u(I-1,j+1) = OBC_FLATHER_N - endif - endif - endif - enddo ; enddo - endif - - if (apply_OBC_v_flather_south) then - ! Determine where v points are applied at south side - do J=JsdB,JedB ; do i=isd,ied - if ((J+G%jdg_offset) == south_boundary) then !southern side - if (G%mask2dCv(i,J) > 0.50) then - OBC%OBC_mask_v(i,J) = .true. - OBC%OBC_kind_v(i,J) = OBC_FLATHER_S - if (G%mask2dCu(I,j) > 0.50) then - OBC%OBC_mask_u(I,j) = .true. - if (OBC%OBC_kind_u(I,j) == OBC_NONE) OBC%OBC_kind_u(I,j) = OBC_FLATHER_S - endif - if (G%mask2dCu(I-1,j) > 0.50) then - OBC%OBC_mask_u(I-1,j) = .true. - if (OBC%OBC_kind_u(I-1,j) == OBC_NONE) OBC%OBC_kind_u(I-1,j) = OBC_FLATHER_S - endif - endif - endif - enddo ; enddo - endif - - ! If there are no OBC points on this PE, there is no reason to keep the OBC - ! type, and it could be deallocated. - - - ! Define radiation coefficients r[xy]_old_[uvh] as needed. For now, there are - ! no radiation conditions applied to the thicknesses, since the thicknesses - ! might not be physically motivated. Instead, sponges should be used to - ! enforce the near-boundary layer structure. - if (apply_OBC_u_flather_west .or. apply_OBC_u_flather_east) then - allocate(OBC%rx_old_u(IsdB:IedB,jsd:jed,nz)) ; OBC%rx_old_u(:,:,:) = 0.0 - ! allocate(OBC%rx_old_h(Isd:Ied,jsd:jed,nz)) ; OBC%rx_old_h(:,:,:) = 0.0 - endif - if (apply_OBC_v_flather_south .or. apply_OBC_v_flather_north) then - allocate(OBC%ry_old_v(isd:ied,JsdB:JedB,nz)) ; OBC%ry_old_v(:,:,:) = 0.0 - ! allocate(OBC%ry_old_h(isd:ied,Jsd:Jed,nz)) ; OBC%ry_old_h(:,:,:) = 0.0 - endif - - - if (associated(tv%T)) then - allocate(OBC_T_u(IsdB:IedB,jsd:jed,nz)) ; OBC_T_u(:,:,:) = 0.0 - allocate(OBC_S_u(IsdB:IedB,jsd:jed,nz)) ; OBC_S_u(:,:,:) = 0.0 - allocate(OBC_T_v(isd:ied,JsdB:JedB,nz)) ; OBC_T_v(:,:,:) = 0.0 - allocate(OBC_S_v(isd:ied,JsdB:JedB,nz)) ; OBC_S_v(:,:,:) = 0.0 - - if (read_OBC_TS) then - call read_data(filename, 'OBC_T_u', OBC_T_u, & - domain=G%Domain%mpp_domain, position=EAST_FACE) - call read_data(filename, 'OBC_S_u', OBC_S_u, & - domain=G%Domain%mpp_domain, position=EAST_FACE) - - call read_data(filename, 'OBC_T_v', OBC_T_v, & - domain=G%Domain%mpp_domain, position=NORTH_FACE) - call read_data(filename, 'OBC_S_v', OBC_S_v, & - domain=G%Domain%mpp_domain, position=NORTH_FACE) - else - call pass_var(tv%T, G%Domain) - call pass_var(tv%S, G%Domain) - do k=1,nz ; do j=js,je ; do I=is-1,ie - if (OBC%OBC_mask_u(I,j)) then - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) then - OBC_T_u(I,j,k) = tv%T(i,j,k) - OBC_S_u(I,j,k) = tv%S(i,j,k) - elseif (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) then - OBC_T_u(I,j,k) = tv%T(i+1,j,k) - OBC_S_u(I,j,k) = tv%S(i+1,j,k) - elseif (G%mask2dT(i,j) + G%mask2dT(i+1,j) > 0) then - OBC_T_u(I,j,k) = (G%mask2dT(i,j)*tv%T(i,j,k) + G%mask2dT(i+1,j)*tv%T(i+1,j,k)) / & - (G%mask2dT(i,j) + G%mask2dT(i+1,j)) - OBC_S_u(I,j,k) = (G%mask2dT(i,j)*tv%S(i,j,k) + G%mask2dT(i+1,j)*tv%S(i+1,j,k)) / & - (G%mask2dT(i,j) + G%mask2dT(i+1,j)) - else ! This probably shouldn't happen or maybe it doesn't matter? - OBC_T_u(I,j,k) = 0.5*(tv%T(i,j,k)+tv%T(i+1,j,k)) - OBC_S_u(I,j,k) = 0.5*(tv%S(i,j,k)+tv%S(i+1,j,k)) - endif - else - OBC_T_u(I,j,k) = 0.5*(tv%T(i,j,k)+tv%T(i+1,j,k)) - OBC_S_u(I,j,k) = 0.5*(tv%S(i,j,k)+tv%S(i+1,j,k)) - endif - enddo; enddo ; enddo - - do k=1,nz ; do J=js-1,je ; do i=is,ie - if (OBC%OBC_mask_v(i,J)) then - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) then - OBC_T_v(i,J,k) = tv%T(i,j,k) - OBC_S_v(i,J,k) = tv%S(i,j,k) - elseif (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) then - OBC_T_v(i,J,k) = tv%T(i,j+1,k) - OBC_S_v(i,J,k) = tv%S(i,j+1,k) - elseif (G%mask2dT(i,j) + G%mask2dT(i,j+1) > 0) then - OBC_T_v(i,J,k) = (G%mask2dT(i,j)*tv%T(i,j,k) + G%mask2dT(i,j+1)*tv%T(i,j+1,k)) / & - (G%mask2dT(i,j) + G%mask2dT(i,j+1)) - OBC_S_v(i,J,k) = (G%mask2dT(i,j)*tv%S(i,j,k) + G%mask2dT(i,j+1)*tv%S(i,j+1,k)) / & - (G%mask2dT(i,j) + G%mask2dT(i,j+1)) - else ! This probably shouldn't happen or maybe it doesn't matter? - OBC_T_v(i,J,k) = 0.5*(tv%T(i,j,k)+tv%T(i,j+1,k)) - OBC_S_v(i,J,k) = 0.5*(tv%S(i,j,k)+tv%S(i,j+1,k)) - endif - else - OBC_T_v(i,J,k) = 0.5*(tv%T(i,j,k)+tv%T(i,j+1,k)) - OBC_S_v(i,J,k) = 0.5*(tv%S(i,j,k)+tv%S(i,j+1,k)) - endif - enddo; enddo ; enddo - endif - - call pass_vector(OBC_T_u, OBC_T_v, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) - call pass_vector(OBC_S_u, OBC_S_v, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) - - call add_tracer_OBC_values("T", tracer_Reg, OBC_in_u=OBC_T_u, & - OBC_in_v=OBC_T_v) - call add_tracer_OBC_values("S", tracer_Reg, OBC_in_u=OBC_S_u, & - OBC_in_v=OBC_S_v) - do k=1,nz ; do j=js,je ; do I=is-1,ie - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) then - tv%T(i+1,j,k) = tv%T(i,j,k) ; tv%S(i+1,j,k) = tv%S(i,j,k) - elseif (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) then - tv%T(i,j,k) = tv%T(i+1,j,k) ; tv%S(i,j,k) = tv%S(i+1,j,k) - endif - enddo ; enddo ; enddo - do k=1,nz ; do J=js-1,je ; do i=is,ie - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) then - tv%T(i,j+1,k) = tv%T(i,j,k) ; tv%S(i,j+1,k) = tv%S(i,j,k) - elseif (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) then - tv%T(i,j,k) = tv%T(i,j+1,k) ; tv%S(i,j,k) = tv%S(i,j+1,k) - endif - enddo ; enddo ; enddo - endif - - do k=1,nz ; do j=js-1,je+1 ; do I=is-1,ie+1 - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) h(i+1,j,k) = h(i,j,k) - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) h(i,j,k) = h(i+1,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=js-1,je+1 ; do i=is-1,ie+1 - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) h(i,j+1,k) = h(i,j,k) - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) h(i,j,k) = h(i,j+1,k) - enddo ; enddo ; enddo - -end subroutine set_Flather_Bdry_Conds -! ----------------------------------------------------------------------------- - ! ----------------------------------------------------------------------------- subroutine set_velocity_depth_max(G) type(ocean_grid_type), intent(inout) :: G From 0248eb2db2348fafa84a616d7310ed155b53cb52 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 14 Jun 2016 18:47:38 -0400 Subject: [PATCH 11/33] Separated set_Flather_... into fixed and state parts - The old routine set_Flather_Bdry_Conds used to set both the masks and data, all hard-corded to be along the edges of the domain. This separates the setting of masks and the construction of the boundary data. - This is part of a larger re-factor of OBC code. - No answer changes. --- src/core/MOM_open_boundary.F90 | 218 ++++++++---------- .../MOM_fixed_initialization.F90 | 3 + .../MOM_state_initialization.F90 | 13 +- 3 files changed, 113 insertions(+), 121 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 400c414698..027a5b3474 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -22,7 +22,8 @@ module MOM_open_boundary public open_boundary_query public open_boundary_end public Radiation_Open_Bdry_Conds -public set_Flather_Bdry_Conds +public set_Flather_positions +public set_Flather_data integer, parameter, public :: OBC_NONE = 0, OBC_SIMPLE = 1, OBC_WALL = 2 integer, parameter, public :: OBC_FLATHER_E = 4, OBC_FLATHER_W = 5 @@ -312,9 +313,106 @@ subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & end subroutine Radiation_Open_Bdry_Conds +!> Sets the domain boundaries as Flather open boundaries using the original +!! Flather run-time logicals +subroutine set_Flather_positions(G, OBC) + type(ocean_grid_type), intent(inout) :: G + type(ocean_OBC_type), pointer :: OBC + ! Local variables + integer :: east_boundary, west_boundary, north_boundary, south_boundary + integer :: i, j + + if (.not.associated(OBC%OBC_mask_u)) then + allocate(OBC%OBC_mask_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; OBC%OBC_mask_u(:,:) = .false. + endif + if (.not.associated(OBC%OBC_kind_u)) then + allocate(OBC%OBC_kind_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; OBC%OBC_kind_u(:,:) = OBC_NONE + endif + if (.not.associated(OBC%OBC_mask_v)) then + allocate(OBC%OBC_mask_v(G%isd:G%ied,G%JsdB:G%JedB)) ; OBC%OBC_mask_v(:,:) = .false. + endif + if (.not.associated(OBC%OBC_kind_v)) then + allocate(OBC%OBC_kind_v(G%isd:G%ied,G%JsdB:G%JedB)) ; OBC%OBC_kind_v(:,:) = OBC_NONE + endif + + ! This code should be modified to allow OBCs to be applied anywhere. + + if (G%symmetric) then + east_boundary = G%ieg + west_boundary = G%isg-1 + north_boundary = G%jeg + south_boundary = G%jsg-1 + else + ! I am not entirely sure that this works properly. -RWH + east_boundary = G%ieg-1 + west_boundary = G%isg + north_boundary = G%jeg-1 + south_boundary = G%jsg + endif + + if (OBC%apply_OBC_u_flather_east) then + ! Determine where u points are applied at east side + do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + if ((I+G%idg_offset) == east_boundary) then !eastern side + OBC%OBC_mask_u(I,j) = .true. + OBC%OBC_kind_u(I,j) = OBC_FLATHER_E + OBC%OBC_mask_v(i+1,J) = .true. + if (OBC%OBC_kind_v(i+1,J) == OBC_NONE) OBC%OBC_kind_v(i+1,J) = OBC_FLATHER_E + OBC%OBC_mask_v(i+1,J-1) = .true. + if (OBC%OBC_kind_v(i+1,J-1) == OBC_NONE) OBC%OBC_kind_v(i+1,J-1) = OBC_FLATHER_E + endif + enddo ; enddo + endif + + if (OBC%apply_OBC_u_flather_west) then + ! Determine where u points are applied at west side + do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + if ((I+G%idg_offset) == west_boundary) then !western side + OBC%OBC_mask_u(I,j) = .true. + OBC%OBC_kind_u(I,j) = OBC_FLATHER_W + OBC%OBC_mask_v(i,J) = .true. + if (OBC%OBC_kind_v(i,J) == OBC_NONE) OBC%OBC_kind_v(i,J) = OBC_FLATHER_W + OBC%OBC_mask_v(i,J-1) = .true. + if (OBC%OBC_kind_v(i,J-1) == OBC_NONE) OBC%OBC_kind_v(i,J-1) = OBC_FLATHER_W + endif + enddo ; enddo + endif + + if (OBC%apply_OBC_v_flather_north) then + ! Determine where v points are applied at north side + do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + if ((J+G%jdg_offset) == north_boundary) then !northern side + OBC%OBC_mask_v(i,J) = .true. + OBC%OBC_kind_v(i,J) = OBC_FLATHER_N + OBC%OBC_mask_u(I,j+1) = .true. + if (OBC%OBC_kind_u(I,j+1) == OBC_NONE) OBC%OBC_kind_u(I,j+1) = OBC_FLATHER_N + OBC%OBC_mask_u(I-1,j+1) = .true. + if (OBC%OBC_kind_u(I-1,j+1) == OBC_NONE) OBC%OBC_kind_u(I-1,j+1) = OBC_FLATHER_N + endif + enddo ; enddo + endif + + if (OBC%apply_OBC_v_flather_south) then + ! Determine where v points are applied at south side + do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + if ((J+G%jdg_offset) == south_boundary) then !southern side + OBC%OBC_mask_v(i,J) = .true. + OBC%OBC_kind_v(i,J) = OBC_FLATHER_S + OBC%OBC_mask_u(I,j) = .true. + if (OBC%OBC_kind_u(I,j) == OBC_NONE) OBC%OBC_kind_u(I,j) = OBC_FLATHER_S + OBC%OBC_mask_u(I-1,j) = .true. + if (OBC%OBC_kind_u(I-1,j) == OBC_NONE) OBC%OBC_kind_u(I-1,j) = OBC_FLATHER_S + endif + enddo ; enddo + endif + + ! If there are no OBC points on this PE, there is no reason to keep the OBC + ! type, and it could be deallocated. +end subroutine set_Flather_positions + !> Sets the initial definitions of the characteristic open boundary conditions. !! \author Mehmet Ilicak -subroutine set_Flather_Bdry_Conds(OBC, tv, h, G, PF, tracer_Reg) +subroutine set_Flather_data(OBC, tv, h, G, PF, tracer_Reg) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(ocean_OBC_type), pointer :: OBC !< Open boundary structure type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure @@ -328,7 +426,6 @@ subroutine set_Flather_Bdry_Conds(OBC, tv, h, G, PF, tracer_Reg) integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, nz integer :: isd_off, jsd_off integer :: IsdB, IedB, JsdB, JedB - integer :: east_boundary, west_boundary, north_boundary, south_boundary character(len=40) :: mod = "set_Flather_Bdry_Conds" ! This subroutine's name. character(len=200) :: filename, OBC_file, inputdir ! Strings for file/path @@ -367,32 +464,6 @@ subroutine set_Flather_Bdry_Conds(OBC, tv, h, G, PF, tracer_Reg) call log_param(PF, mod, "INPUTDIR/OBC_FILE", filename) endif - if (G%symmetric) then - east_boundary = G%ieg - west_boundary = G%isg-1 - north_boundary = G%jeg - south_boundary = G%jsg-1 - else - ! I am not entirely sure that this works properly. -RWH - east_boundary = G%ieg-1 - west_boundary = G%isg - north_boundary = G%jeg-1 - south_boundary = G%jsg - endif - - if (.not.associated(OBC%OBC_mask_u)) then - allocate(OBC%OBC_mask_u(IsdB:IedB,jsd:jed)) ; OBC%OBC_mask_u(:,:) = .false. - endif - if (.not.associated(OBC%OBC_kind_u)) then - allocate(OBC%OBC_kind_u(IsdB:IedB,jsd:jed)) ; OBC%OBC_kind_u(:,:) = OBC_NONE - endif - if (.not.associated(OBC%OBC_mask_v)) then - allocate(OBC%OBC_mask_v(isd:ied,JsdB:JedB)) ; OBC%OBC_mask_v(:,:) = .false. - endif - if (.not.associated(OBC%OBC_kind_v)) then - allocate(OBC%OBC_kind_v(isd:ied,JsdB:JedB)) ; OBC%OBC_kind_v(:,:) = OBC_NONE - endif - if (.not.associated(OBC%vbt_outer)) then allocate(OBC%vbt_outer(isd:ied,JsdB:JedB)) ; OBC%vbt_outer(:,:) = 0.0 endif @@ -426,93 +497,6 @@ subroutine set_Flather_Bdry_Conds(OBC, tv, h, G, PF, tracer_Reg) call pass_vector(OBC%eta_outer_u,OBC%eta_outer_v,G%Domain, To_All+SCALAR_PAIR, CGRID_NE) call pass_vector(OBC%ubt_outer,OBC%vbt_outer,G%Domain) - ! This code should be modified to allow OBCs to be applied anywhere. - - if (OBC%apply_OBC_u_flather_east) then - ! Determine where u points are applied at east side - do j=jsd,jed ; do I=IsdB,IedB - if ((I+G%idg_offset) == east_boundary) then !eastern side - if (G%mask2dCu(I,j) > 0.50) then - OBC%OBC_mask_u(I,j) = .true. - OBC%OBC_kind_u(I,j) = OBC_FLATHER_E - if (G%mask2dCv(i+1,J) > 0.50) then - OBC%OBC_mask_v(i+1,J) = .true. - if (OBC%OBC_kind_v(i+1,J) == OBC_NONE) OBC%OBC_kind_v(i+1,J) = OBC_FLATHER_E - endif - if (G%mask2dCv(i+1,J-1) > 0.50) then - OBC%OBC_mask_v(i+1,J-1) = .true. - if (OBC%OBC_kind_v(i+1,J-1) == OBC_NONE) OBC%OBC_kind_v(i+1,J-1) = OBC_FLATHER_E - endif - endif - endif - enddo ; enddo - endif - - if (OBC%apply_OBC_u_flather_west) then - ! Determine where u points are applied at west side - do j=jsd,jed ; do I=IsdB,IedB - if ((I+G%idg_offset) == west_boundary) then !western side - if (G%mask2dCu(I,j) > 0.50) then - OBC%OBC_mask_u(I,j) = .true. - OBC%OBC_kind_u(I,j) = OBC_FLATHER_W - if (G%mask2dCv(i,J) > 0.50) then - OBC%OBC_mask_v(i,J) = .true. - if (OBC%OBC_kind_v(i,J) == OBC_NONE) OBC%OBC_kind_v(i,J) = OBC_FLATHER_W - endif - if (G%mask2dCv(i,J-1) > 0.50) then - OBC%OBC_mask_v(i,J-1) = .true. - if (OBC%OBC_kind_v(i,J-1) == OBC_NONE) OBC%OBC_kind_v(i,J-1) = OBC_FLATHER_W - endif - endif - endif - enddo ; enddo - endif - - - if (OBC%apply_OBC_v_flather_north) then - ! Determine where v points are applied at north side - do J=JsdB,JedB ; do i=isd,ied - if ((J+G%jdg_offset) == north_boundary) then !northern side - if (G%mask2dCv(i,J) > 0.50) then - OBC%OBC_mask_v(i,J) = .true. - OBC%OBC_kind_v(i,J) = OBC_FLATHER_N - if (G%mask2dCu(I,j+1) > 0.50) then - OBC%OBC_mask_u(I,j+1) = .true. - if (OBC%OBC_kind_u(I,j+1) == OBC_NONE) OBC%OBC_kind_u(I,j+1) = OBC_FLATHER_N - endif - if (G%mask2dCu(I-1,j+1) > 0.50) then - OBC%OBC_mask_u(I-1,j+1) = .true. - if (OBC%OBC_kind_u(I-1,j+1) == OBC_NONE) OBC%OBC_kind_u(I-1,j+1) = OBC_FLATHER_N - endif - endif - endif - enddo ; enddo - endif - - if (OBC%apply_OBC_v_flather_south) then - ! Determine where v points are applied at south side - do J=JsdB,JedB ; do i=isd,ied - if ((J+G%jdg_offset) == south_boundary) then !southern side - if (G%mask2dCv(i,J) > 0.50) then - OBC%OBC_mask_v(i,J) = .true. - OBC%OBC_kind_v(i,J) = OBC_FLATHER_S - if (G%mask2dCu(I,j) > 0.50) then - OBC%OBC_mask_u(I,j) = .true. - if (OBC%OBC_kind_u(I,j) == OBC_NONE) OBC%OBC_kind_u(I,j) = OBC_FLATHER_S - endif - if (G%mask2dCu(I-1,j) > 0.50) then - OBC%OBC_mask_u(I-1,j) = .true. - if (OBC%OBC_kind_u(I-1,j) == OBC_NONE) OBC%OBC_kind_u(I-1,j) = OBC_FLATHER_S - endif - endif - endif - enddo ; enddo - endif - - ! If there are no OBC points on this PE, there is no reason to keep the OBC - ! type, and it could be deallocated. - - ! Define radiation coefficients r[xy]_old_[uvh] as needed. For now, there are ! no radiation conditions applied to the thicknesses, since the thicknesses ! might not be physically motivated. Instead, sponges should be used to @@ -625,7 +609,7 @@ subroutine set_Flather_Bdry_Conds(OBC, tv, h, G, PF, tracer_Reg) if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) h(i,j,k) = h(i,j+1,k) enddo ; enddo ; enddo -end subroutine set_Flather_Bdry_Conds +end subroutine set_Flather_data !> \namespace mom_open_boundary !! This module implements some aspects of internal open boundary diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 175bc2d076..e9cd32e0ad 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -20,6 +20,7 @@ module MOM_fixed_initialization use MOM_grid_initialize, only : initialize_masks, set_grid_metrics use MOM_open_boundary, only : ocean_OBC_type use MOM_open_boundary, only : open_boundary_config, open_boundary_query +use MOM_open_boundary, only : set_Flather_positions use MOM_string_functions, only : uppercase use user_initialization, only : user_initialize_topography, USER_set_OBC_positions use DOME_initialization, only : DOME_initialize_topography, DOME_set_OBC_positions @@ -99,6 +100,8 @@ subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir) "The open boundary positions specified by OBC_CONFIG="//& trim(config)//" have not been fully implemented.") end select + elseif (open_boundary_query(OBC, apply_orig_Flather=.true.)) then + call set_Flather_positions(G, OBC) endif ! This call sets seamasks that prohibit flow over any point with ! diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index cf77120ee3..b1e7328f7c 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -23,7 +23,7 @@ module MOM_state_initialization use MOM_io, only : EAST_FACE, NORTH_FACE use MOM_open_boundary, only : ocean_OBC_type use MOM_open_boundary, only : OBC_NONE, OBC_SIMPLE -use MOM_open_boundary, only : open_boundary_query, set_Flather_Bdry_Conds +use MOM_open_boundary, only : open_boundary_query, set_Flather_data, set_Flather_positions use MOM_grid_initialize, only : initialize_masks, set_grid_metrics use MOM_restart, only : restore_state, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, set_up_sponge_ML_density @@ -432,10 +432,15 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & "OBC_CONFIG = "//trim(config)//" have not been fully implemented.") call set_Open_Bdry_Conds(OBC, tv, G, GV, PF, tracer_Reg) endif + elseif (open_boundary_query(OBC, apply_orig_Flather=.true.)) then +! call set_Flather_positions(G, OBC) + call set_Flather_data(OBC, tv, h, G, PF, tracer_Reg) endif - - if (open_boundary_query(OBC, apply_orig_Flather=.true.)) then - call set_Flather_Bdry_Conds(OBC, tv, h, G, PF, tracer_Reg) + if (debug.and.associated(OBC)) then + call hchksum(G%mask2dT, 'MOM_initialize_state: mask2dT ', G%HI) + call uchksum(G%mask2dCu, 'MOM_initialize_state: mask2dCu ', G%HI) + call vchksum(G%mask2dCv, 'MOM_initialize_state: mask2dCv ', G%HI) + call qchksum(G%mask2dBu, 'MOM_initialize_state: mask2dBu ', G%HI) endif call callTree_leave('MOM_initialize_state()') From 0b8dc7beaecf4b3cb33bc36b01e237a3889125d4 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 14 Jun 2016 20:01:14 -0400 Subject: [PATCH 12/33] New function open_boundary_impose_normal_slope() - initialize_masks() in MOM_grid_initialization.F90 used to read the open-boundary parameters and then adjust the topography on the edge of the domain only. - There is no mention of "Flather" in MOM_grid_initialization.F90 any more. - MOM_fixed_initialization.F90 now calls this new routine prior to calling initialize_masks(). - I had to move a pass_var(G%bathyT) out of initialize_masks() and up to MOM_initialize_fixed() to do this. - This is part of a larger re-factor of OBC code. - No answer changes. --- src/core/MOM_open_boundary.F90 | 35 ++++++++++++ .../MOM_fixed_initialization.F90 | 11 +++- src/initialization/MOM_grid_initialize.F90 | 56 +------------------ 3 files changed, 44 insertions(+), 58 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 027a5b3474..5968bfd924 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -21,6 +21,7 @@ module MOM_open_boundary public open_boundary_init public open_boundary_query public open_boundary_end +public open_boundary_impose_normal_slope public Radiation_Open_Bdry_Conds public set_Flather_positions public set_Flather_data @@ -132,6 +133,14 @@ subroutine open_boundary_config(G, param_file, OBC) "Apply a Flather open boundary condition on the southern\n"//& "side of the global domain", & default=.false.) + + ! Safety check + if ((OBC%apply_OBC_u_flather_west .or. OBC%apply_OBC_v_flather_south) .and. & + .not.G%symmetric ) call MOM_error(FATAL, & + "MOM_open_boundary, open_boundary_config: "//& + "Symmetric memory must be used when APPLY_OBC_U_FLATHER_WEST "//& + "or APPLY_OBC_V_FLATHER_SOUTH is true.") + if (.not.(OBC%apply_OBC_u .or. OBC%apply_OBC_v .or. & OBC%apply_OBC_v_flather_north .or. OBC%apply_OBC_v_flather_south .or. & OBC%apply_OBC_u_flather_east .or. OBC%apply_OBC_u_flather_west)) then @@ -199,6 +208,32 @@ subroutine open_boundary_end(OBC) deallocate(OBC) end subroutine open_boundary_end +!> Sets the slope of bathymetry normal to an open bounndary to zero. +subroutine open_boundary_impose_normal_slope(OBC, G, depth) + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: depth !< Bathymetry at h-points + ! Local variables + integer :: i, j + + if (.not.associated(OBC)) return + + if (associated(OBC%OBC_kind_u)) then + do j=G%jsd,G%jed ; do I=G%isd,G%ied-1 + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) depth(i+1,j) = depth(i,j) + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) depth(i,j) = depth(i+1,j) + enddo ; enddo + endif + + if (associated(OBC%OBC_kind_v)) then + do J=G%jsd,G%jed-1 ; do i=G%isd,G%ied + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) depth(i,j+1) = depth(i,j) + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) depth(i,j) = depth(i,j+1) + enddo ; enddo + endif + +end subroutine open_boundary_impose_normal_slope + !> Diagnose radiation conditions at open boundaries subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & h_new, h_old, G) diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index e9cd32e0ad..fd31128063 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -20,7 +20,7 @@ module MOM_fixed_initialization use MOM_grid_initialize, only : initialize_masks, set_grid_metrics use MOM_open_boundary, only : ocean_OBC_type use MOM_open_boundary, only : open_boundary_config, open_boundary_query -use MOM_open_boundary, only : set_Flather_positions +use MOM_open_boundary, only : set_Flather_positions, open_boundary_impose_normal_slope use MOM_string_functions, only : uppercase use user_initialization, only : user_initialize_topography, USER_set_OBC_positions use DOME_initialization, only : DOME_initialize_topography, DOME_set_OBC_positions @@ -104,8 +104,13 @@ subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir) call set_Flather_positions(G, OBC) endif -! This call sets seamasks that prohibit flow over any point with ! -! a bottom that is shallower than min_depth from PF. ! + ! To initialize masks, the bathymetry in halo regions must be filled in + call pass_var(G%bathyT, G%Domain) + + ! Make bathymetry consistent with open boundaries + call open_boundary_impose_normal_slope(OBC, G, G%bathyT) + + ! This call sets masks that prohibit flow over any point interpreted as land call initialize_masks(G, PF) if (debug) then call hchksum(G%bathyT, 'MOM_initialize_fixed: depth ', G%HI, haloshift=1) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 03332babf1..6bb268cd3a 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -1343,8 +1343,6 @@ subroutine initialize_masks(G, PF) real :: Dmin, min_depth, mask_depth integer :: i, j - logical :: apply_OBC_u_flather_east, apply_OBC_u_flather_west - logical :: apply_OBC_v_flather_north, apply_OBC_v_flather_south character(len=40) :: mod = "MOM_grid_init initialize_masks" call callTree_enter("initialize_masks(), MOM_grid_initialize.F90") @@ -1358,65 +1356,13 @@ subroutine initialize_masks(G, PF) "The depth below which to mask points as land points, for which all\n"//& "fluxes are zeroed out. MASKING_DEPTH is ignored if negative.", & units="m", default=-9999.0) - call get_param(PF, mod, "APPLY_OBC_U_FLATHER_EAST", apply_OBC_u_flather_east,& - "Apply a Flather open boundary condition on the eastern \n"//& - "side of the global domain", default=.false.) - call get_param(PF, mod, "APPLY_OBC_U_FLATHER_WEST", apply_OBC_u_flather_west,& - "Apply a Flather open boundary condition on the western \n"//& - "side of the global domain", default=.false.) - call get_param(PF, mod, "APPLY_OBC_V_FLATHER_NORTH", apply_OBC_v_flather_north,& - "Apply a Flather open boundary condition on the northern \n"//& - "side of the global domain", default=.false.) - call get_param(PF, mod, "APPLY_OBC_V_FLATHER_SOUTH", apply_OBC_v_flather_south,& - "Apply a Flather open boundary condition on the southern \n"//& - "side of the global domain", default=.false.) - - if ((apply_OBC_u_flather_west .or. apply_OBC_v_flather_south) .and. & - .not.G%symmetric ) & - call MOM_error(FATAL, "Symmetric memory must be used when "//& - "APPLY_OBC_U_FLATHER_WEST or APPLY_OBC_V_FLATHER_SOUTH is true.") Dmin = min_depth if (mask_depth>=0.) Dmin = mask_depth - call pass_var(G%bathyT, G%Domain) G%mask2dCu(:,:) = 0.0 ; G%mask2dCv(:,:) = 0.0 ; G%mask2dBu(:,:) = 0.0 - ! Extrapolate the bottom depths at any points that are subject to Flather - ! open boundary conditions. This should be generalized for Flather OBCs - ! that are not necessarily at the edges of the domain. - if (apply_OBC_u_flather_west) then - do j=G%jsd,G%jed ; do I=G%isd+1,G%ied - if ((I+G%idg_offset) == G%isg) then - G%bathyT(i-1,j) = G%bathyT(i,j) - endif - enddo; enddo - endif - - if (apply_OBC_u_flather_east) then - do j=G%jsd,G%jed ; do I=G%isd,G%ied-1 - if ((i+G%idg_offset) == G%ieg) then - G%bathyT(i+1,j) = G%bathyT(i,j) - endif - enddo; enddo - endif - - if (apply_OBC_v_flather_north) then - do J=G%jsd,G%jed-1 ; do i=G%isd,G%ied - if ((j+G%jdg_offset) == G%jeg) then - G%bathyT(i,j+1) = G%bathyT(i,j) - endif - enddo; enddo - endif - - if (apply_OBC_v_flather_south) then - do J=G%jsd+1,G%jed ; do i=G%isd,G%ied - if ((J+G%jdg_offset) == G%jsg) then - G%bathyT(i,j-1) = G%bathyT(i,j) - endif - enddo; enddo - endif - + ! Construct the h-point or T-point mask do j=G%jsd,G%jed ; do i=G%isd,G%ied if (G%bathyT(i,j) <= Dmin) then G%mask2dT(i,j) = 0.0 From 643063c9a18c8011a6c4fd5eed2d6793d92d686c Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 14 Jun 2016 20:15:10 -0400 Subject: [PATCH 13/33] Added license line to MOM_open_boundary.F90 - Forgot to add the license line when doxygenizing. - No answer changes. --- src/core/MOM_open_boundary.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 5968bfd924..be61791dc3 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1,6 +1,8 @@ !> Controls where open boundary conditions are applied module MOM_open_boundary +! This file is part of MOM6. See LICENSE.md for the license. + use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_domains, only : pass_var, pass_vector From 2074943698b5dd63a58ad19b83195566b9f98472 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Tue, 14 Jun 2016 16:31:52 -0800 Subject: [PATCH 14/33] License line and loop bounds fix. --- src/core/MOM_open_boundary.F90 | 1 + src/initialization/MOM_state_initialization.F90 | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index ea419ae4c6..9b9bde6c1a 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1,3 +1,4 @@ +! This file is part of MOM6. See LICENSE.md for the license. !> Controls where open boundary conditions are applied module MOM_open_boundary diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 0f9568cd2c..dfccb40631 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -2008,11 +2008,11 @@ subroutine set_Flather_Bdry_Conds(OBC, tv, h, G, PF, tracer_Reg) enddo ; enddo ; enddo endif - do k=1,nz ; do j=js-1,je+1 ; do I=is-1,ie+1 + do k=1,nz ; do j=jsd,jed ; do I=isd,ied if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) h(i+1,j,k) = h(i,j,k) if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) h(i,j,k) = h(i+1,j,k) enddo ; enddo ; enddo - do k=1,nz ; do J=js-1,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do J=jsd,jed ; do i=isd,ied if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) h(i,j+1,k) = h(i,j,k) if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) h(i,j,k) = h(i,j+1,k) enddo ; enddo ; enddo From 2558954ec1366b2cb320974734840959f4b51cb8 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 14 Jun 2016 21:04:29 -0400 Subject: [PATCH 15/33] Moved call to open_boundary_init from MOM to MOM_state_initialize - The call to open_boundary_init() was immediately after the call to MOM_initialize_state(). It is now immediately above the calls to DOME_set_OBC_data, etc. - No answer changes. --- src/core/MOM.F90 | 3 +-- src/core/MOM_open_boundary.F90 | 4 +--- src/initialization/MOM_state_initialization.F90 | 8 +++++--- 3 files changed, 7 insertions(+), 8 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index c2156d9cbf..4bdd7bf17d 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -98,7 +98,7 @@ module MOM use MOM_mixed_layer_restrat, only : mixedlayer_restrat_register_restarts use MOM_neutral_diffusion, only : neutral_diffusion_CS, neutral_diffusion_diag_init use MOM_obsolete_diagnostics, only : register_obsolete_diagnostics -use MOM_open_boundary, only : Radiation_Open_Bdry_Conds, open_boundary_init +use MOM_open_boundary, only : Radiation_Open_Bdry_Conds use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_init use MOM_set_visc, only : set_visc_register_restarts, set_visc_CS @@ -1799,7 +1799,6 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, param_file, & dirs, CS%restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & CS%sponge_CSp, CS%ALE_sponge_CSp, CS%OBC, Time_in) - call open_boundary_init(Time, G, param_file, diag, CS%OBC) call cpu_clock_end(id_clock_MOM_init) call callTree_waypoint("returned from MOM_initialize_state() (initialize_MOM)") diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index be61791dc3..c530519cc8 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -153,11 +153,9 @@ subroutine open_boundary_config(G, param_file, OBC) end subroutine open_boundary_config !> Initialize open boundary control structure -subroutine open_boundary_init(Time, G, param_file, diag, OBC) - type(time_type), target, intent(in) :: Time !< Current model time +subroutine open_boundary_init(G, param_file, OBC) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(param_file_type), intent(in) :: param_file !< Parameter file handle - type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure ! Local variables diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index b1e7328f7c..17290657bd 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -21,7 +21,7 @@ module MOM_state_initialization use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE, MULTIPLE use MOM_io, only : slasher, vardesc, write_field use MOM_io, only : EAST_FACE, NORTH_FACE -use MOM_open_boundary, only : ocean_OBC_type +use MOM_open_boundary, only : ocean_OBC_type, open_boundary_init use MOM_open_boundary, only : OBC_NONE, OBC_SIMPLE use MOM_open_boundary, only : open_boundary_query, set_Flather_data, set_Flather_positions use MOM_grid_initialize, only : initialize_masks, set_grid_metrics @@ -420,7 +420,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & end select endif -! This subroutine call sets optional open boundary conditions. + ! Reads OBC parameters not pertaining to the location of the boundaries + call open_boundary_init(G, PF, OBC) + + ! This is the legacy approach to turning on open boundaries if (open_boundary_query(OBC, apply_orig_OBCs=.true.)) then call get_param(PF, mod, "OBC_CONFIG", config, fail_if_missing=.true., do_not_log=.true.) if (trim(config) == "DOME") then @@ -433,7 +436,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & call set_Open_Bdry_Conds(OBC, tv, G, GV, PF, tracer_Reg) endif elseif (open_boundary_query(OBC, apply_orig_Flather=.true.)) then -! call set_Flather_positions(G, OBC) call set_Flather_data(OBC, tv, h, G, PF, tracer_Reg) endif if (debug.and.associated(OBC)) then From ee365bd6bc0544754a39cbec4f7832e2332025ac Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Tue, 14 Jun 2016 21:26:16 -0400 Subject: [PATCH 16/33] Loop bound fix in set_Flather_Bdry_data() - This is a conflict resolution: @khedstrom implemented a loop bound fix in a routine that I had just moved to a different module. The resolution was to re-implemented it in the new location. - No answer changes. --- src/core/MOM_open_boundary.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index c530519cc8..b153250248 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -619,14 +619,14 @@ subroutine set_Flather_data(OBC, tv, h, G, PF, tracer_Reg) OBC_in_v=OBC_T_v) call add_tracer_OBC_values("S", tracer_Reg, OBC_in_u=OBC_S_u, & OBC_in_v=OBC_S_v) - do k=1,nz ; do j=js,je ; do I=is-1,ie + do k=1,nz ; do j=jsd,jed ; do I=isd,ied-1 if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) then tv%T(i+1,j,k) = tv%T(i,j,k) ; tv%S(i+1,j,k) = tv%S(i,j,k) elseif (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) then tv%T(i,j,k) = tv%T(i+1,j,k) ; tv%S(i,j,k) = tv%S(i+1,j,k) endif enddo ; enddo ; enddo - do k=1,nz ; do J=js-1,je ; do i=is,ie + do k=1,nz ; do J=jsd,jed-1 ; do i=isd,ied if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) then tv%T(i,j+1,k) = tv%T(i,j,k) ; tv%S(i,j+1,k) = tv%S(i,j,k) elseif (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) then @@ -635,11 +635,11 @@ subroutine set_Flather_data(OBC, tv, h, G, PF, tracer_Reg) enddo ; enddo ; enddo endif - do k=1,nz ; do j=js-1,je+1 ; do I=is-1,ie+1 + do k=1,nz ; do j=jsd,jed ; do I=isd,ied-1 if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) h(i+1,j,k) = h(i,j,k) if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) h(i,j,k) = h(i+1,j,k) enddo ; enddo ; enddo - do k=1,nz ; do J=js-1,je+1 ; do i=is-1,ie+1 + do k=1,nz ; do J=jsd,jed-1 ; do i=isd,ied if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) h(i,j+1,k) = h(i,j,k) if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) h(i,j,k) = h(i,j+1,k) enddo ; enddo ; enddo From 5e86623de6509a293c107fbd791ab93704e681fa Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Tue, 14 Jun 2016 20:36:10 -0800 Subject: [PATCH 17/33] Merge from aja/obc_refactor --- src/core/MOM.F90 | 5 +- src/core/MOM_dynamics_legacy_split.F90 | 13 +- src/core/MOM_dynamics_split_RK2.F90 | 13 +- src/core/MOM_dynamics_unsplit.F90 | 9 +- src/core/MOM_dynamics_unsplit_RK2.F90 | 9 +- src/core/MOM_open_boundary.F90 | 537 +++++++++++++++--- .../MOM_fixed_initialization.F90 | 41 +- src/initialization/MOM_grid_initialize.F90 | 56 +- .../MOM_state_initialization.F90 | 418 +------------- src/user/DOME_initialization.F90 | 126 ++-- src/user/user_initialization.F90 | 25 +- 11 files changed, 603 insertions(+), 649 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index cc2f199989..4bdd7bf17d 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -98,7 +98,7 @@ module MOM use MOM_mixed_layer_restrat, only : mixedlayer_restrat_register_restarts use MOM_neutral_diffusion, only : neutral_diffusion_CS, neutral_diffusion_diag_init use MOM_obsolete_diagnostics, only : register_obsolete_diagnostics -use MOM_open_boundary, only : Radiation_Open_Bdry_Conds, open_boundary_init +use MOM_open_boundary, only : Radiation_Open_Bdry_Conds use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_init use MOM_set_visc, only : set_visc_register_restarts, set_visc_CS @@ -1785,7 +1785,7 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call callTree_waypoint("restart registration complete (initialize_MOM)") call cpu_clock_begin(id_clock_MOM_init) - call MOM_initialize_fixed(G, param_file, write_geom_files, dirs%output_directory) + call MOM_initialize_fixed(G, CS%OBC, param_file, write_geom_files, dirs%output_directory) call callTree_waypoint("returned from MOM_initialize_fixed() (initialize_MOM)") call MOM_initialize_coord(GV, param_file, write_geom_files, & dirs%output_directory, CS%tv, G%max_depth) @@ -1916,7 +1916,6 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in) call wave_speed_init(Time, G, param_file, diag, CS%wave_speed_CSp) call VarMix_init(Time, G, param_file, diag, CS%VarMix, CS%wave_speed_CSp) call set_visc_init(Time, G, GV, param_file, diag, CS%visc, CS%set_visc_CSp) - if (CS%split) then allocate(eta(SZI_(G),SZJ_(G))) ; eta(:,:) = 0.0 if (CS%legacy_split) then diff --git a/src/core/MOM_dynamics_legacy_split.F90 b/src/core/MOM_dynamics_legacy_split.F90 index 3ad5c3363c..77b9f3c6f5 100644 --- a/src/core/MOM_dynamics_legacy_split.F90 +++ b/src/core/MOM_dynamics_legacy_split.F90 @@ -110,8 +110,7 @@ module MOM_dynamics_legacy_split use MOM_interface_heights, only : find_eta use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type -use MOM_open_boundary, only : Radiation_Open_Bdry_Conds, open_boundary_init -use MOM_open_boundary, only : open_boundary_CS +use MOM_open_boundary, only : Radiation_Open_Bdry_Conds use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_remnant @@ -241,7 +240,6 @@ module MOM_dynamics_legacy_split type(legacy_barotropic_CS), pointer :: barotropic_CSp => NULL() type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() type(set_visc_CS), pointer :: set_visc_CSp => NULL() - type(open_boundary_CS), pointer :: open_boundary_CSp => NULL() type(ocean_OBC_type), pointer :: OBC => NULL() ! A pointer to an open boundary ! condition type that specifies whether, where, and what open boundary ! conditions are used. If no open BCs are used, this pointer stays @@ -739,7 +737,7 @@ subroutine step_MOM_dyn_legacy_split(u, v, h, tv, visc, & if (associated(CS%OBC)) then call Radiation_Open_Bdry_Conds(CS%OBC, u_av, u_old_rad_OBC, v_av, & - v_old_rad_OBC, hp, h_old_rad_OBC, G, CS%open_boundary_CSp) + v_old_rad_OBC, hp, h_old_rad_OBC, G) endif ! h_av = (h + hp)/2 @@ -998,7 +996,7 @@ subroutine step_MOM_dyn_legacy_split(u, v, h, tv, visc, & if (associated(CS%OBC)) then call Radiation_Open_Bdry_Conds(CS%OBC, u, u_old_rad_OBC, v, & - v_old_rad_OBC, h, h_old_rad_OBC, G, CS%open_boundary_CSp) + v_old_rad_OBC, h, h_old_rad_OBC, G) endif ! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in. @@ -1380,10 +1378,7 @@ subroutine initialize_dyn_legacy_split(u, v, h, uh, vh, eta, Time, G, GV, param_ CS%set_visc_CSp => setVisc_CSp if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp - if (associated(OBC)) then - CS%OBC => OBC - call open_boundary_init(Time, G, param_file, diag, CS%open_boundary_CSp) - endif + if (associated(OBC)) CS%OBC => OBC if (.not. query_initialized(CS%eta,"sfc",restart_CS)) then ! Estimate eta based on the layer thicknesses - h. With the Boussinesq diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index b65ab8281c..2e2173a502 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -46,8 +46,7 @@ module MOM_dynamics_split_RK2 use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type use MOM_open_boundary, only : ocean_OBC_type -use MOM_open_boundary, only : Radiation_Open_Bdry_Conds, open_boundary_init -use MOM_open_boundary, only : open_boundary_CS +use MOM_open_boundary, only : Radiation_Open_Bdry_Conds use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS @@ -161,7 +160,6 @@ module MOM_dynamics_split_RK2 type(barotropic_CS), pointer :: barotropic_CSp => NULL() type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() type(set_visc_CS), pointer :: set_visc_CSp => NULL() - type(open_boundary_CS), pointer :: open_boundary_CSp => NULL() type(tidal_forcing_CS), pointer :: tides_CSp => NULL() type(ocean_OBC_type), pointer :: OBC => NULL() !< A pointer to an open boundary @@ -640,7 +638,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (associated(CS%OBC)) then call Radiation_Open_Bdry_Conds(CS%OBC, u_av, u_old_rad_OBC, v_av, & - v_old_rad_OBC, hp, h_old_rad_OBC, G, CS%open_boundary_CSp) + v_old_rad_OBC, hp, h_old_rad_OBC, G) endif ! h_av = (h + hp)/2 @@ -852,7 +850,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & if (associated(CS%OBC)) then call Radiation_Open_Bdry_Conds(CS%OBC, u, u_old_rad_OBC, v, & - v_old_rad_OBC, h, h_old_rad_OBC, G, CS%open_boundary_CSp) + v_old_rad_OBC, h, h_old_rad_OBC, G) endif ! h_av = (h_in + h_out)/2 . Going in to this line, h_av = h_in. @@ -1141,10 +1139,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil (LEN_TRIM(dirs%input_filename) == 1)) ) if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp - if (associated(OBC)) then - CS%OBC => OBC - call open_boundary_init(Time, G, param_file, diag, CS%open_boundary_CSp) - endif + if (associated(OBC)) CS%OBC => OBC if (.not. query_initialized(CS%eta,"sfc",restart_CS)) then ! Estimate eta based on the layer thicknesses - h. With the Boussinesq diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 6c50d2b80a..fc392cbb88 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -103,8 +103,7 @@ module MOM_dynamics_unsplit use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type use MOM_open_boundary, only : ocean_OBC_type -use MOM_open_boundary, only : Radiation_Open_Bdry_Conds, open_boundary_init -use MOM_open_boundary, only : open_boundary_CS +use MOM_open_boundary, only : Radiation_Open_Bdry_Conds use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS @@ -156,7 +155,6 @@ module MOM_dynamics_unsplit type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() type(set_visc_CS), pointer :: set_visc_CSp => NULL() - type(open_boundary_CS), pointer :: open_boundary_CSp => NULL() type(ocean_OBC_type), pointer :: OBC => NULL() ! A pointer to an open boundary ! condition type that specifies whether, where, and what open boundary ! conditions are used. If no open BCs are used, this pointer stays @@ -680,10 +678,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, param_file, diag, CS, & CS%set_visc_CSp => setVisc_CSp if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp - if (associated(OBC)) then - CS%OBC => OBC - call open_boundary_init(Time, G, param_file, diag, CS%open_boundary_CSp) - endif + if (associated(OBC)) CS%OBC => OBC flux_units = get_flux_units(GV) CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 7055547e0a..8e228a9189 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -101,8 +101,7 @@ module MOM_dynamics_unsplit_RK2 use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type use MOM_open_boundary, only : ocean_OBC_type -use MOM_open_boundary, only : Radiation_Open_Bdry_Conds, open_boundary_init -use MOM_open_boundary, only : open_boundary_CS +use MOM_open_boundary, only : Radiation_Open_Bdry_Conds use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS @@ -162,7 +161,6 @@ module MOM_dynamics_unsplit_RK2 type(PressureForce_CS), pointer :: PressureForce_CSp => NULL() type(vertvisc_CS), pointer :: vertvisc_CSp => NULL() type(set_visc_CS), pointer :: set_visc_CSp => NULL() - type(open_boundary_CS), pointer :: open_boundary_CSp => NULL() type(ocean_OBC_type), pointer :: OBC => NULL() ! A pointer to an open boundary ! condition type that specifies whether, where, and what open boundary ! conditions are used. If no open BCs are used, this pointer stays @@ -644,10 +642,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, param_file, diag, CS CS%set_visc_CSp => setVisc_CSp if (associated(ALE_CSp)) CS%ALE_CSp => ALE_CSp - if (associated(OBC)) then - CS%OBC => OBC - call open_boundary_init(Time, G, param_file, diag, CS%open_boundary_CSp) - endif + if (associated(OBC)) CS%OBC => OBC flux_units = get_flux_units(GV) CS%id_uh = register_diag_field('ocean_model', 'uh', diag%axesCuL, Time, & diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 9b9bde6c1a..60768f93b0 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -2,33 +2,32 @@ !> Controls where open boundary conditions are applied module MOM_open_boundary +! This file is part of MOM6. See LICENSE.md for the license. + use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : diag_ctrl, time_type use MOM_domains, only : pass_var, pass_vector +use MOM_domains, only : To_All, SCALAR_PAIR, CGRID_NE use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_file_parser, only : get_param, log_version, param_file_type, log_param use MOM_grid, only : ocean_grid_type +use MOM_io, only : EAST_FACE, NORTH_FACE +use MOM_io, only : slasher, read_data +use MOM_tracer_registry, only : add_tracer_OBC_values, tracer_registry_type +use MOM_variables, only : thermo_var_ptrs implicit none ; private #include -public Radiation_Open_Bdry_Conds, open_boundary_init, open_boundary_end - -!> The control structure for open-boundaries -type, public :: open_boundary_CS ; private - real :: gamma_uv !< The relative weighting for the baroclinic radiation - !! velocities (or speed of characteristics) at the - !! new time level (1) or the running mean (0) for velocities. - !! Valid values range from 0 to 1, with a default of 0.3. - real :: gamma_h !< The relative weighting for the baroclinic radiation - !! velocities (or speed of characteristics) at the - !! new time level (1) or the running mean (0) for thicknesses. - !! Valid values range from 0 to 1, with a default of 0.2. - real :: rx_max !< The maximum magnitude of the baroclinic radiation - !! velocity (or speed of characteristics), in m s-1. The - !! default value is 10 m s-1. -end type open_boundary_CS +public open_boundary_config +public open_boundary_init +public open_boundary_query +public open_boundary_end +public open_boundary_impose_normal_slope +public Radiation_Open_Bdry_Conds +public set_Flather_positions +public set_Flather_data integer, parameter, public :: OBC_NONE = 0, OBC_SIMPLE = 1, OBC_WALL = 2 integer, parameter, public :: OBC_FLATHER_E = 4, OBC_FLATHER_W = 5 @@ -79,6 +78,19 @@ module MOM_open_boundary v => NULL(), & !< The prescribed values of the meridional velocity (v) at OBC points. uh => NULL(), & !< The prescribed values of the zonal volume transport (uh) at OBC points. vh => NULL() !< The prescribed values of the meridional volume transport (vh) at OBC points. + + ! The following parameters are used in the baroclinic radiation code: + real :: gamma_uv !< The relative weighting for the baroclinic radiation + !! velocities (or speed of characteristics) at the + !! new time level (1) or the running mean (0) for velocities. + !! Valid values range from 0 to 1, with a default of 0.3. + real :: gamma_h !< The relative weighting for the baroclinic radiation + !! velocities (or speed of characteristics) at the + !! new time level (1) or the running mean (0) for thicknesses. + !! Valid values range from 0 to 1, with a default of 0.2. + real :: rx_max !< The maximum magnitude of the baroclinic radiation + !! velocity (or speed of characteristics), in m s-1. The + !! default value is 10 m s-1. end type ocean_OBC_type integer :: id_clock_pass @@ -89,18 +101,151 @@ module MOM_open_boundary contains +!> Enables OBC module and reads configuration parameters +subroutine open_boundary_config(G, param_file, OBC) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(param_file_type), intent(in) :: param_file !< Parameter file handle + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + ! Local variables + logical :: flather_east, flather_west, flather_north, flather_south + + allocate(OBC) + + call log_version(param_file, mod, version) + call get_param(param_file, mod, "APPLY_OBC_U", OBC%apply_OBC_u, & + "If true, open boundary conditions may be set at some \n"//& + "u-points, with the configuration controlled by OBC_CONFIG", & + default=.false.) + call get_param(param_file, mod, "APPLY_OBC_V", OBC%apply_OBC_v, & + "If true, open boundary conditions may be set at some \n"//& + "v-points, with the configuration controlled by OBC_CONFIG", & + default=.false.) + call get_param(param_file, mod, "APPLY_OBC_U_FLATHER_EAST", OBC%apply_OBC_u_flather_east, & + "Apply a Flather open boundary condition on the eastern\n"//& + "side of the global domain", & + default=.false.) + call get_param(param_file, mod, "APPLY_OBC_U_FLATHER_WEST", OBC%apply_OBC_u_flather_west, & + "Apply a Flather open boundary condition on the western\n"//& + "side of the global domain", & + default=.false.) + call get_param(param_file, mod, "APPLY_OBC_V_FLATHER_NORTH", OBC%apply_OBC_v_flather_north, & + "Apply a Flather open boundary condition on the northern\n"//& + "side of the global domain", & + default=.false.) + call get_param(param_file, mod, "APPLY_OBC_V_FLATHER_SOUTH", OBC%apply_OBC_v_flather_south, & + "Apply a Flather open boundary condition on the southern\n"//& + "side of the global domain", & + default=.false.) + + ! Safety check + if ((OBC%apply_OBC_u_flather_west .or. OBC%apply_OBC_v_flather_south) .and. & + .not.G%symmetric ) call MOM_error(FATAL, & + "MOM_open_boundary, open_boundary_config: "//& + "Symmetric memory must be used when APPLY_OBC_U_FLATHER_WEST "//& + "or APPLY_OBC_V_FLATHER_SOUTH is true.") + + if (.not.(OBC%apply_OBC_u .or. OBC%apply_OBC_v .or. & + OBC%apply_OBC_v_flather_north .or. OBC%apply_OBC_v_flather_south .or. & + OBC%apply_OBC_u_flather_east .or. OBC%apply_OBC_u_flather_west)) then + ! No open boundaries have been requested + deallocate(OBC) + endif + +end subroutine open_boundary_config + +!> Initialize open boundary control structure +subroutine open_boundary_init(G, param_file, OBC) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(param_file_type), intent(in) :: param_file !< Parameter file handle + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + ! Local variables + + if (.not.associated(OBC)) return + + if ( OBC%apply_OBC_v_flather_north .or. OBC%apply_OBC_v_flather_south .or. & + OBC%apply_OBC_u_flather_east .or. OBC%apply_OBC_u_flather_west ) then + call get_param(param_file, mod, "OBC_RADIATION_MAX", OBC%rx_max, & + "The maximum magnitude of the baroclinic radiation \n"//& + "velocity (or speed of characteristics). This is only \n"//& + "used if one of the APPLY_OBC_[UV]_FLATHER_... is true.", & + units="m s-1", default=10.0) + call get_param(param_file, mod, "OBC_RAD_VEL_WT", OBC%gamma_uv, & + "The relative weighting for the baroclinic radiation \n"//& + "velocities (or speed of characteristics) at the new \n"//& + "time level (1) or the running mean (0) for velocities. \n"//& + "Valid values range from 0 to 1. This is only used if \n"//& + "one of the APPLY_OBC_[UV]_FLATHER_... is true.", & + units="nondim", default=0.3) + call get_param(param_file, mod, "OBC_RAD_THICK_WT", OBC%gamma_h, & + "The relative weighting for the baroclinic radiation \n"//& + "velocities (or speed of characteristics) at the new \n"//& + "time level (1) or the running mean (0) for thicknesses. \n"//& + "Valid values range from 0 to 1. This is only used if \n"//& + "one of the APPLY_OBC_[UV]_FLATHER_... is true.", & + units="nondim", default=0.2) + endif + + id_clock_pass = cpu_clock_id('(Ocean OBC halo updates)', grain=CLOCK_ROUTINE) + +end subroutine open_boundary_init + +!> Query the state of open boundary module configuration +logical function open_boundary_query(OBC, apply_orig_OBCs, apply_orig_Flather) + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + logical, optional, intent(in) :: apply_orig_OBCs !< If present, returns True if APPLY_OBC_U/V was set + logical, optional, intent(in) :: apply_orig_Flather !< If present, returns True if APPLY_OBC_*_FLATHER_* was set + open_boundary_query = .false. + if (.not. associated(OBC)) return + if (present(apply_orig_OBCs)) open_boundary_query = OBC%apply_OBC_u .or. OBC%apply_OBC_v + if (present(apply_orig_Flather)) open_boundary_query = OBC%apply_OBC_v_flather_north .or. & + OBC%apply_OBC_v_flather_south .or. & + OBC%apply_OBC_u_flather_east .or. & + OBC%apply_OBC_u_flather_west +end function open_boundary_query + +!> Deallocate open boundary data +subroutine open_boundary_end(OBC) + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + deallocate(OBC) +end subroutine open_boundary_end + +!> Sets the slope of bathymetry normal to an open bounndary to zero. +subroutine open_boundary_impose_normal_slope(OBC, G, depth) + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: depth !< Bathymetry at h-points + ! Local variables + integer :: i, j + + if (.not.associated(OBC)) return + + if (associated(OBC%OBC_kind_u)) then + do j=G%jsd,G%jed ; do I=G%isd,G%ied-1 + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) depth(i+1,j) = depth(i,j) + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) depth(i,j) = depth(i+1,j) + enddo ; enddo + endif + + if (associated(OBC%OBC_kind_v)) then + do J=G%jsd,G%jed-1 ; do i=G%isd,G%ied + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) depth(i,j+1) = depth(i,j) + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) depth(i,j) = depth(i,j+1) + enddo ; enddo + endif + +end subroutine open_boundary_impose_normal_slope + !> Diagnose radiation conditions at open boundaries subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & - h_new, h_old, G, CS) + h_new, h_old, G) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure - type(ocean_OBC_type), pointer :: OBC !< Open boundary data + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_new real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u_old real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_new real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v_old real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_new real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old - type(open_boundary_CS), pointer :: CS !< Open boundary control structure ! Local variables real :: dhdt, dhdx, gamma_u, gamma_h, gamma_v real :: rx_max, ry_max ! coefficients for radiation @@ -113,11 +258,9 @@ subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & if (.not.(OBC%apply_OBC_u_flather_east .or. OBC%apply_OBC_u_flather_west .or. & OBC%apply_OBC_v_flather_north .or. OBC%apply_OBC_v_flather_south)) & return - if (.not.associated(CS)) call MOM_error(FATAL, & - "MOM_open_boundary: Module must be initialized before it is used.") - gamma_u = CS%gamma_uv ; gamma_v = CS%gamma_uv ; gamma_h = CS%gamma_h - rx_max = CS%rx_max ; ry_max = CS%rx_max + gamma_u = OBC%gamma_uv ; gamma_v = OBC%gamma_uv ; gamma_h = OBC%gamma_h + rx_max = OBC%rx_max ; ry_max = OBC%rx_max if (OBC%apply_OBC_u_flather_east .or. OBC%apply_OBC_u_flather_west) then do k=1,nz ; do j=js,je ; do I=is-1,ie ; if (OBC%OBC_mask_u(I,j)) then @@ -206,71 +349,303 @@ subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & end subroutine Radiation_Open_Bdry_Conds -!> Initialize open boundary control structure -subroutine open_boundary_init(Time, G, param_file, diag, CS) - type(time_type), target, intent(in) :: Time !< Current model time - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(param_file_type), intent(in) :: param_file !< Parameter file handle - type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure - type(open_boundary_CS), pointer :: CS !< Open boundary control structure +!> Sets the domain boundaries as Flather open boundaries using the original +!! Flather run-time logicals +subroutine set_Flather_positions(G, OBC) + type(ocean_grid_type), intent(inout) :: G + type(ocean_OBC_type), pointer :: OBC ! Local variables - logical :: flather_east, flather_west, flather_north, flather_south + integer :: east_boundary, west_boundary, north_boundary, south_boundary + integer :: i, j - if (associated(CS)) then - call MOM_error(WARNING, "MOM_open_boundary: open_boundary_init called with associated control structure.") - return + if (.not.associated(OBC%OBC_mask_u)) then + allocate(OBC%OBC_mask_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; OBC%OBC_mask_u(:,:) = .false. + endif + if (.not.associated(OBC%OBC_kind_u)) then + allocate(OBC%OBC_kind_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; OBC%OBC_kind_u(:,:) = OBC_NONE + endif + if (.not.associated(OBC%OBC_mask_v)) then + allocate(OBC%OBC_mask_v(G%isd:G%ied,G%JsdB:G%JedB)) ; OBC%OBC_mask_v(:,:) = .false. + endif + if (.not.associated(OBC%OBC_kind_v)) then + allocate(OBC%OBC_kind_v(G%isd:G%ied,G%JsdB:G%JedB)) ; OBC%OBC_kind_v(:,:) = OBC_NONE endif - call log_version(param_file, mod, version) - call get_param(param_file, mod, "APPLY_OBC_U_FLATHER_EAST", flather_east, & - "If true, some zonal velocity points use Flather open \n"//& - "boundary conditions on the east side of the ocean.", & - default=.false.) - call get_param(param_file, mod, "APPLY_OBC_U_FLATHER_WEST", flather_west, & - "If true, some zonal velocity points use Flather open \n"//& - "boundary conditions on the west side of the ocean.", & - default=.false.) - call get_param(param_file, mod, "APPLY_OBC_V_FLATHER_NORTH", flather_north, & - "If true, some meridional velocity points use Flather \n"//& - "open boundary conditions on the north side of the ocean.", & - default=.false.) - call get_param(param_file, mod, "APPLY_OBC_V_FLATHER_SOUTH", flather_south, & - "If true, some meridional velocity points use Flather \n"//& - "open boundary conditions on the north side of the ocean.", & + ! This code should be modified to allow OBCs to be applied anywhere. + + if (G%symmetric) then + east_boundary = G%ieg + west_boundary = G%isg-1 + north_boundary = G%jeg + south_boundary = G%jsg-1 + else + ! I am not entirely sure that this works properly. -RWH + east_boundary = G%ieg-1 + west_boundary = G%isg + north_boundary = G%jeg-1 + south_boundary = G%jsg + endif + + if (OBC%apply_OBC_u_flather_east) then + ! Determine where u points are applied at east side + do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + if ((I+G%idg_offset) == east_boundary) then !eastern side + OBC%OBC_mask_u(I,j) = .true. + OBC%OBC_kind_u(I,j) = OBC_FLATHER_E + OBC%OBC_mask_v(i+1,J) = .true. + if (OBC%OBC_kind_v(i+1,J) == OBC_NONE) OBC%OBC_kind_v(i+1,J) = OBC_FLATHER_E + OBC%OBC_mask_v(i+1,J-1) = .true. + if (OBC%OBC_kind_v(i+1,J-1) == OBC_NONE) OBC%OBC_kind_v(i+1,J-1) = OBC_FLATHER_E + endif + enddo ; enddo + endif + + if (OBC%apply_OBC_u_flather_west) then + ! Determine where u points are applied at west side + do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + if ((I+G%idg_offset) == west_boundary) then !western side + OBC%OBC_mask_u(I,j) = .true. + OBC%OBC_kind_u(I,j) = OBC_FLATHER_W + OBC%OBC_mask_v(i,J) = .true. + if (OBC%OBC_kind_v(i,J) == OBC_NONE) OBC%OBC_kind_v(i,J) = OBC_FLATHER_W + OBC%OBC_mask_v(i,J-1) = .true. + if (OBC%OBC_kind_v(i,J-1) == OBC_NONE) OBC%OBC_kind_v(i,J-1) = OBC_FLATHER_W + endif + enddo ; enddo + endif + + if (OBC%apply_OBC_v_flather_north) then + ! Determine where v points are applied at north side + do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + if ((J+G%jdg_offset) == north_boundary) then !northern side + OBC%OBC_mask_v(i,J) = .true. + OBC%OBC_kind_v(i,J) = OBC_FLATHER_N + OBC%OBC_mask_u(I,j+1) = .true. + if (OBC%OBC_kind_u(I,j+1) == OBC_NONE) OBC%OBC_kind_u(I,j+1) = OBC_FLATHER_N + OBC%OBC_mask_u(I-1,j+1) = .true. + if (OBC%OBC_kind_u(I-1,j+1) == OBC_NONE) OBC%OBC_kind_u(I-1,j+1) = OBC_FLATHER_N + endif + enddo ; enddo + endif + + if (OBC%apply_OBC_v_flather_south) then + ! Determine where v points are applied at south side + do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + if ((J+G%jdg_offset) == south_boundary) then !southern side + OBC%OBC_mask_v(i,J) = .true. + OBC%OBC_kind_v(i,J) = OBC_FLATHER_S + OBC%OBC_mask_u(I,j) = .true. + if (OBC%OBC_kind_u(I,j) == OBC_NONE) OBC%OBC_kind_u(I,j) = OBC_FLATHER_S + OBC%OBC_mask_u(I-1,j) = .true. + if (OBC%OBC_kind_u(I-1,j) == OBC_NONE) OBC%OBC_kind_u(I-1,j) = OBC_FLATHER_S + endif + enddo ; enddo + endif + + ! If there are no OBC points on this PE, there is no reason to keep the OBC + ! type, and it could be deallocated. +end subroutine set_Flather_positions + +!> Sets the initial definitions of the characteristic open boundary conditions. +!! \author Mehmet Ilicak +subroutine set_Flather_data(OBC, tv, h, G, PF, tracer_Reg) + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure + real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(inout) :: h !< Thickness + type(param_file_type), intent(in) :: PF !< Parameter file handle + type(tracer_registry_type), pointer :: tracer_Reg !< Tracer registry + ! Local variables + logical :: read_OBC_eta = .false. + logical :: read_OBC_uv = .false. + logical :: read_OBC_TS = .false. + integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, nz + integer :: isd_off, jsd_off + integer :: IsdB, IedB, JsdB, JedB + character(len=40) :: mod = "set_Flather_Bdry_Conds" ! This subroutine's name. + character(len=200) :: filename, OBC_file, inputdir ! Strings for file/path + + real :: temp_u(G%domain%niglobal+1,G%domain%njglobal) + real :: temp_v(G%domain%niglobal,G%domain%njglobal+1) + + real, pointer, dimension(:,:,:) :: & + OBC_T_u => NULL(), & ! These arrays should be allocated and set to + OBC_T_v => NULL(), & ! specify the values of T and S that should come + OBC_S_u => NULL(), & + OBC_S_v => NULL() + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%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 + + call get_param(PF, mod, "READ_OBC_UV", read_OBC_uv, & + "If true, read the values for the velocity open boundary \n"//& + "conditions from the file specified by OBC_FILE.", & default=.false.) - if (.not.(flather_east .or. flather_west .or. flather_north .or. & - flather_south)) return - - allocate(CS) - call get_param(param_file, mod, "OBC_RADIATION_MAX", CS%rx_max, & - "The maximum magnitude of the baroclinic radiation \n"//& - "velocity (or speed of characteristics). This is only \n"//& - "used if one of the APPLY_OBC_[UV]_FLATHER_... is true.", & - units="m s-1", default=10.0) - call get_param(param_file, mod, "OBC_RAD_VEL_WT", CS%gamma_uv, & - "The relative weighting for the baroclinic radiation \n"//& - "velocities (or speed of characteristics) at the new \n"//& - "time level (1) or the running mean (0) for velocities. \n"//& - "Valid values range from 0 to 1. This is only used if \n"//& - "one of the APPLY_OBC_[UV]_FLATHER_... is true.", & - units="nondim", default=0.3) - call get_param(param_file, mod, "OBC_RAD_THICK_WT", CS%gamma_h, & - "The relative weighting for the baroclinic radiation \n"//& - "velocities (or speed of characteristics) at the new \n"//& - "time level (1) or the running mean (0) for thicknesses. \n"//& - "Valid values range from 0 to 1. This is only used if \n"//& - "one of the APPLY_OBC_[UV]_FLATHER_... is true.", & - units="nondim", default=0.2) + call get_param(PF, mod, "READ_OBC_ETA", read_OBC_eta, & + "If true, read the values for the sea surface height \n"//& + "open boundary conditions from the file specified by \n"//& + "OBC_FILE.", default=.false.) + call get_param(PF, mod, "READ_OBC_TS", read_OBC_TS, & + "If true, read the values for the temperature and \n"//& + "salinity open boundary conditions from the file \n"//& + "specified by OBC_FILE.", default=.false.) + if (read_OBC_uv .or. read_OBC_eta .or. read_OBC_TS) then + call get_param(PF, mod, "OBC_FILE", OBC_file, & + "The file from which the appropriate open boundary \n"//& + "condition values are read.", default="MOM_OBC_FILE.nc") + call get_param(PF, mod, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) + filename = trim(inputdir)//trim(OBC_file) + call log_param(PF, mod, "INPUTDIR/OBC_FILE", filename) + endif - id_clock_pass = cpu_clock_id('(Ocean OBC halo updates)', grain=CLOCK_ROUTINE) + if (.not.associated(OBC%vbt_outer)) then + allocate(OBC%vbt_outer(isd:ied,JsdB:JedB)) ; OBC%vbt_outer(:,:) = 0.0 + endif -end subroutine open_boundary_init + if (.not.associated(OBC%ubt_outer)) then + allocate(OBC%ubt_outer(IsdB:IedB,jsd:jed)) ; OBC%ubt_outer(:,:) = 0.0 + endif -!> Deallocate open boundary data -subroutine open_boundary_end(CS) - type(open_boundary_CS), pointer :: CS !< Open boundary control structure - deallocate(CS) -end subroutine open_boundary_end + if (.not.associated(OBC%eta_outer_u)) then + allocate(OBC%eta_outer_u(IsdB:IedB,jsd:jed)) ; OBC%eta_outer_u(:,:) = 0.0 + endif + + if (.not.associated(OBC%eta_outer_v)) then + allocate(OBC%eta_outer_v(isd:ied,JsdB:JedB)) ; OBC%eta_outer_v(:,:) = 0.0 + endif + + if (read_OBC_uv) then + call read_data(filename, 'ubt', OBC%ubt_outer, & + domain=G%Domain%mpp_domain, position=EAST_FACE) + call read_data(filename, 'vbt', OBC%vbt_outer, & + domain=G%Domain%mpp_domain, position=NORTH_FACE) + endif + + if (read_OBC_eta) then + call read_data(filename, 'eta_outer_u', OBC%eta_outer_u, & + domain=G%Domain%mpp_domain, position=EAST_FACE) + call read_data(filename, 'eta_outer_v', OBC%eta_outer_v, & + domain=G%Domain%mpp_domain, position=NORTH_FACE) + endif + + call pass_vector(OBC%eta_outer_u,OBC%eta_outer_v,G%Domain, To_All+SCALAR_PAIR, CGRID_NE) + call pass_vector(OBC%ubt_outer,OBC%vbt_outer,G%Domain) + + ! Define radiation coefficients r[xy]_old_[uvh] as needed. For now, there are + ! no radiation conditions applied to the thicknesses, since the thicknesses + ! might not be physically motivated. Instead, sponges should be used to + ! enforce the near-boundary layer structure. + if (OBC%apply_OBC_u_flather_west .or. OBC%apply_OBC_u_flather_east) then + allocate(OBC%rx_old_u(IsdB:IedB,jsd:jed,nz)) ; OBC%rx_old_u(:,:,:) = 0.0 + ! allocate(OBC%rx_old_h(Isd:Ied,jsd:jed,nz)) ; OBC%rx_old_h(:,:,:) = 0.0 + endif + if (OBC%apply_OBC_v_flather_south .or. OBC%apply_OBC_v_flather_north) then + allocate(OBC%ry_old_v(isd:ied,JsdB:JedB,nz)) ; OBC%ry_old_v(:,:,:) = 0.0 + ! allocate(OBC%ry_old_h(isd:ied,Jsd:Jed,nz)) ; OBC%ry_old_h(:,:,:) = 0.0 + endif + + + if (associated(tv%T)) then + allocate(OBC_T_u(IsdB:IedB,jsd:jed,nz)) ; OBC_T_u(:,:,:) = 0.0 + allocate(OBC_S_u(IsdB:IedB,jsd:jed,nz)) ; OBC_S_u(:,:,:) = 0.0 + allocate(OBC_T_v(isd:ied,JsdB:JedB,nz)) ; OBC_T_v(:,:,:) = 0.0 + allocate(OBC_S_v(isd:ied,JsdB:JedB,nz)) ; OBC_S_v(:,:,:) = 0.0 + + if (read_OBC_TS) then + call read_data(filename, 'OBC_T_u', OBC_T_u, & + domain=G%Domain%mpp_domain, position=EAST_FACE) + call read_data(filename, 'OBC_S_u', OBC_S_u, & + domain=G%Domain%mpp_domain, position=EAST_FACE) + + call read_data(filename, 'OBC_T_v', OBC_T_v, & + domain=G%Domain%mpp_domain, position=NORTH_FACE) + call read_data(filename, 'OBC_S_v', OBC_S_v, & + domain=G%Domain%mpp_domain, position=NORTH_FACE) + else + call pass_var(tv%T, G%Domain) + call pass_var(tv%S, G%Domain) + do k=1,nz ; do j=js,je ; do I=is-1,ie + if (OBC%OBC_mask_u(I,j)) then + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) then + OBC_T_u(I,j,k) = tv%T(i,j,k) + OBC_S_u(I,j,k) = tv%S(i,j,k) + elseif (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) then + OBC_T_u(I,j,k) = tv%T(i+1,j,k) + OBC_S_u(I,j,k) = tv%S(i+1,j,k) + elseif (G%mask2dT(i,j) + G%mask2dT(i+1,j) > 0) then + OBC_T_u(I,j,k) = (G%mask2dT(i,j)*tv%T(i,j,k) + G%mask2dT(i+1,j)*tv%T(i+1,j,k)) / & + (G%mask2dT(i,j) + G%mask2dT(i+1,j)) + OBC_S_u(I,j,k) = (G%mask2dT(i,j)*tv%S(i,j,k) + G%mask2dT(i+1,j)*tv%S(i+1,j,k)) / & + (G%mask2dT(i,j) + G%mask2dT(i+1,j)) + else ! This probably shouldn't happen or maybe it doesn't matter? + OBC_T_u(I,j,k) = 0.5*(tv%T(i,j,k)+tv%T(i+1,j,k)) + OBC_S_u(I,j,k) = 0.5*(tv%S(i,j,k)+tv%S(i+1,j,k)) + endif + else + OBC_T_u(I,j,k) = 0.5*(tv%T(i,j,k)+tv%T(i+1,j,k)) + OBC_S_u(I,j,k) = 0.5*(tv%S(i,j,k)+tv%S(i+1,j,k)) + endif + enddo; enddo ; enddo + + do k=1,nz ; do J=js-1,je ; do i=is,ie + if (OBC%OBC_mask_v(i,J)) then + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) then + OBC_T_v(i,J,k) = tv%T(i,j,k) + OBC_S_v(i,J,k) = tv%S(i,j,k) + elseif (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) then + OBC_T_v(i,J,k) = tv%T(i,j+1,k) + OBC_S_v(i,J,k) = tv%S(i,j+1,k) + elseif (G%mask2dT(i,j) + G%mask2dT(i,j+1) > 0) then + OBC_T_v(i,J,k) = (G%mask2dT(i,j)*tv%T(i,j,k) + G%mask2dT(i,j+1)*tv%T(i,j+1,k)) / & + (G%mask2dT(i,j) + G%mask2dT(i,j+1)) + OBC_S_v(i,J,k) = (G%mask2dT(i,j)*tv%S(i,j,k) + G%mask2dT(i,j+1)*tv%S(i,j+1,k)) / & + (G%mask2dT(i,j) + G%mask2dT(i,j+1)) + else ! This probably shouldn't happen or maybe it doesn't matter? + OBC_T_v(i,J,k) = 0.5*(tv%T(i,j,k)+tv%T(i,j+1,k)) + OBC_S_v(i,J,k) = 0.5*(tv%S(i,j,k)+tv%S(i,j+1,k)) + endif + else + OBC_T_v(i,J,k) = 0.5*(tv%T(i,j,k)+tv%T(i,j+1,k)) + OBC_S_v(i,J,k) = 0.5*(tv%S(i,j,k)+tv%S(i,j+1,k)) + endif + enddo; enddo ; enddo + endif + + call pass_vector(OBC_T_u, OBC_T_v, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) + call pass_vector(OBC_S_u, OBC_S_v, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) + + call add_tracer_OBC_values("T", tracer_Reg, OBC_in_u=OBC_T_u, & + OBC_in_v=OBC_T_v) + call add_tracer_OBC_values("S", tracer_Reg, OBC_in_u=OBC_S_u, & + OBC_in_v=OBC_S_v) + do k=1,nz ; do j=jsd,jed ; do I=isd,ied-1 + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) then + tv%T(i+1,j,k) = tv%T(i,j,k) ; tv%S(i+1,j,k) = tv%S(i,j,k) + elseif (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) then + tv%T(i,j,k) = tv%T(i+1,j,k) ; tv%S(i,j,k) = tv%S(i+1,j,k) + endif + enddo ; enddo ; enddo + do k=1,nz ; do J=jsd,jed-1 ; do i=isd,ied + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) then + tv%T(i,j+1,k) = tv%T(i,j,k) ; tv%S(i,j+1,k) = tv%S(i,j,k) + elseif (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) then + tv%T(i,j,k) = tv%T(i,j+1,k) ; tv%S(i,j,k) = tv%S(i,j+1,k) + endif + enddo ; enddo ; enddo + endif + + do k=1,nz ; do j=jsd,jed ; do I=isd,ied-1 + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) h(i+1,j,k) = h(i,j,k) + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) h(i,j,k) = h(i+1,j,k) + enddo ; enddo ; enddo + do k=1,nz ; do J=jsd,jed-1 ; do i=isd,ied + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) h(i,j+1,k) = h(i,j,k) + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) h(i,j,k) = h(i,j+1,k) + enddo ; enddo ; enddo + +end subroutine set_Flather_data !> \namespace mom_open_boundary !! This module implements some aspects of internal open boundary diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 5ebe25a844..fd31128063 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -18,9 +18,12 @@ module MOM_fixed_initialization use MOM_io, only : slasher, vardesc, write_field, var_desc use MOM_io, only : EAST_FACE, NORTH_FACE use MOM_grid_initialize, only : initialize_masks, set_grid_metrics +use MOM_open_boundary, only : ocean_OBC_type +use MOM_open_boundary, only : open_boundary_config, open_boundary_query +use MOM_open_boundary, only : set_Flather_positions, open_boundary_impose_normal_slope use MOM_string_functions, only : uppercase -use user_initialization, only : user_initialize_topography -use DOME_initialization, only : DOME_initialize_topography +use user_initialization, only : user_initialize_topography, USER_set_OBC_positions +use DOME_initialization, only : DOME_initialize_topography, DOME_set_OBC_positions use ISOMIP_initialization, only : ISOMIP_initialize_topography use benchmark_initialization, only : benchmark_initialize_topography use DOME2d_initialization, only : DOME2d_initialize_topography @@ -43,8 +46,9 @@ module MOM_fixed_initialization ! ----------------------------------------------------------------------------- !> MOM_initialize_fixed sets up time-invariant quantities related to MOM6's !! horizontal grid, bathymetry, and the Coriolis parameter. -subroutine MOM_initialize_fixed(G, PF, write_geom, output_dir) +subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure. type(param_file_type), intent(in) :: PF !< A structure indicating the open file !! to parse for model parameter values. logical, intent(in) :: write_geom !< If true, write grid geometry files. @@ -78,8 +82,35 @@ subroutine MOM_initialize_fixed(G, PF, write_geom, output_dir) ! masks, and Coriolis parameter. ! ==================================================================== -! This call sets seamasks that prohibit flow over any point with ! -! a bottom that is shallower than min_depth from PF. ! +! Determine the position of any open boundaries + call open_boundary_config(G, PF, OBC) + if (open_boundary_query(OBC, apply_orig_OBCs=.true.)) then + call get_param(PF, mod, "OBC_CONFIG", config, & + "A string that sets how the open boundary conditions are \n"//& + " configured: \n"//& + " \t DOME - use a slope and channel configuration for the \n"//& + " \t\t DOME sill-overflow test case. \n"//& + " \t USER - call a user modified routine.", default="file", & + fail_if_missing=.true.) + select case ( trim(config) ) + case ("none") + case ("DOME") ; call DOME_set_OBC_positions(G, PF, OBC) + case ("USER") ; call user_set_OBC_positions(G, PF, OBC) + case default ; call MOM_error(FATAL, "MOM_initialize_fixed: "// & + "The open boundary positions specified by OBC_CONFIG="//& + trim(config)//" have not been fully implemented.") + end select + elseif (open_boundary_query(OBC, apply_orig_Flather=.true.)) then + call set_Flather_positions(G, OBC) + endif + + ! To initialize masks, the bathymetry in halo regions must be filled in + call pass_var(G%bathyT, G%Domain) + + ! Make bathymetry consistent with open boundaries + call open_boundary_impose_normal_slope(OBC, G, G%bathyT) + + ! This call sets masks that prohibit flow over any point interpreted as land call initialize_masks(G, PF) if (debug) then call hchksum(G%bathyT, 'MOM_initialize_fixed: depth ', G%HI, haloshift=1) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index 03332babf1..6bb268cd3a 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -1343,8 +1343,6 @@ subroutine initialize_masks(G, PF) real :: Dmin, min_depth, mask_depth integer :: i, j - logical :: apply_OBC_u_flather_east, apply_OBC_u_flather_west - logical :: apply_OBC_v_flather_north, apply_OBC_v_flather_south character(len=40) :: mod = "MOM_grid_init initialize_masks" call callTree_enter("initialize_masks(), MOM_grid_initialize.F90") @@ -1358,65 +1356,13 @@ subroutine initialize_masks(G, PF) "The depth below which to mask points as land points, for which all\n"//& "fluxes are zeroed out. MASKING_DEPTH is ignored if negative.", & units="m", default=-9999.0) - call get_param(PF, mod, "APPLY_OBC_U_FLATHER_EAST", apply_OBC_u_flather_east,& - "Apply a Flather open boundary condition on the eastern \n"//& - "side of the global domain", default=.false.) - call get_param(PF, mod, "APPLY_OBC_U_FLATHER_WEST", apply_OBC_u_flather_west,& - "Apply a Flather open boundary condition on the western \n"//& - "side of the global domain", default=.false.) - call get_param(PF, mod, "APPLY_OBC_V_FLATHER_NORTH", apply_OBC_v_flather_north,& - "Apply a Flather open boundary condition on the northern \n"//& - "side of the global domain", default=.false.) - call get_param(PF, mod, "APPLY_OBC_V_FLATHER_SOUTH", apply_OBC_v_flather_south,& - "Apply a Flather open boundary condition on the southern \n"//& - "side of the global domain", default=.false.) - - if ((apply_OBC_u_flather_west .or. apply_OBC_v_flather_south) .and. & - .not.G%symmetric ) & - call MOM_error(FATAL, "Symmetric memory must be used when "//& - "APPLY_OBC_U_FLATHER_WEST or APPLY_OBC_V_FLATHER_SOUTH is true.") Dmin = min_depth if (mask_depth>=0.) Dmin = mask_depth - call pass_var(G%bathyT, G%Domain) G%mask2dCu(:,:) = 0.0 ; G%mask2dCv(:,:) = 0.0 ; G%mask2dBu(:,:) = 0.0 - ! Extrapolate the bottom depths at any points that are subject to Flather - ! open boundary conditions. This should be generalized for Flather OBCs - ! that are not necessarily at the edges of the domain. - if (apply_OBC_u_flather_west) then - do j=G%jsd,G%jed ; do I=G%isd+1,G%ied - if ((I+G%idg_offset) == G%isg) then - G%bathyT(i-1,j) = G%bathyT(i,j) - endif - enddo; enddo - endif - - if (apply_OBC_u_flather_east) then - do j=G%jsd,G%jed ; do I=G%isd,G%ied-1 - if ((i+G%idg_offset) == G%ieg) then - G%bathyT(i+1,j) = G%bathyT(i,j) - endif - enddo; enddo - endif - - if (apply_OBC_v_flather_north) then - do J=G%jsd,G%jed-1 ; do i=G%isd,G%ied - if ((j+G%jdg_offset) == G%jeg) then - G%bathyT(i,j+1) = G%bathyT(i,j) - endif - enddo; enddo - endif - - if (apply_OBC_v_flather_south) then - do J=G%jsd+1,G%jed ; do i=G%isd,G%ied - if ((J+G%jdg_offset) == G%jsg) then - G%bathyT(i,j-1) = G%bathyT(i,j) - endif - enddo; enddo - endif - + ! Construct the h-point or T-point mask do j=G%jsd,G%jed ; do i=G%isd,G%ied if (G%bathyT(i,j) <= Dmin) then G%mask2dT(i,j) = 0.0 diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index dfccb40631..17290657bd 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -21,9 +21,9 @@ module MOM_state_initialization use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE, MULTIPLE use MOM_io, only : slasher, vardesc, write_field use MOM_io, only : EAST_FACE, NORTH_FACE -use MOM_open_boundary, only : ocean_OBC_type -use MOM_open_boundary, only : OBC_NONE, OBC_SIMPLE, OBC_FLATHER_E, OBC_FLATHER_W -use MOM_open_boundary, only : OBC_FLATHER_N, OBC_FLATHER_S +use MOM_open_boundary, only : ocean_OBC_type, open_boundary_init +use MOM_open_boundary, only : OBC_NONE, OBC_SIMPLE +use MOM_open_boundary, only : open_boundary_query, set_Flather_data, set_Flather_positions use MOM_grid_initialize, only : initialize_masks, set_grid_metrics use MOM_restart, only : restore_state, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, set_up_sponge_ML_density @@ -40,9 +40,10 @@ module MOM_state_initialization use MOM_EOS, only : int_specific_vol_dp use user_initialization, only : user_initialize_thickness, user_initialize_velocity use user_initialization, only : user_init_temperature_salinity -use user_initialization, only : user_set_Open_Bdry_Conds, user_initialize_sponges +use user_initialization, only : user_set_OBC_positions, user_set_OBC_data +use user_initialization, only : user_initialize_sponges use DOME_initialization, only : DOME_initialize_thickness -use DOME_initialization, only : DOME_set_Open_Bdry_Conds +use DOME_initialization, only : DOME_set_OBC_positions, DOME_set_OBC_data use DOME_initialization, only : DOME_initialize_sponges use ISOMIP_initialization, only : ISOMIP_initialize_thickness use ISOMIP_initialization, only : ISOMIP_initialize_sponges @@ -141,9 +142,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & logical :: trim_ic_for_p_surf ! If true, remove the mass that would be displaced ! by a large surface pressure, such as with an ice sheet. logical :: Analytic_FV_PGF, obsol_test - logical :: apply_OBC_u, apply_OBC_v - logical :: apply_OBC_u_flather_east, apply_OBC_u_flather_west - logical :: apply_OBC_v_flather_north, apply_OBC_v_flather_south logical :: convert type(EOS_type), pointer :: eos => NULL() logical :: debug ! indicates whether to write debugging output @@ -422,48 +420,29 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & end select endif -! This subroutine call sets optional open boundary conditions. - call get_param(PF, mod, "APPLY_OBC_U", apply_OBC_u, & - "If true, open boundary conditions may be set at some \n"//& - "u-points, with the configuration controlled by OBC_CONFIG", & - default=.false.) - call get_param(PF, mod, "APPLY_OBC_V", apply_OBC_v, & - "If true, open boundary conditions may be set at some \n"//& - "v-points, with the configuration controlled by OBC_CONFIG", & - default=.false.) - if (apply_OBC_u .or. apply_OBC_v) then - call get_param(PF, mod, "OBC_CONFIG", config, & - "A string that sets how the open boundary conditions are \n"//& - " configured: \n"//& - " \t DOME - use a slope and channel configuration for the \n"//& - " \t\t DOME sill-overflow test case. \n"//& - " \t USER - call a user modified routine.", default="file", & - fail_if_missing=.true.) + ! Reads OBC parameters not pertaining to the location of the boundaries + call open_boundary_init(G, PF, OBC) + + ! This is the legacy approach to turning on open boundaries + if (open_boundary_query(OBC, apply_orig_OBCs=.true.)) then + call get_param(PF, mod, "OBC_CONFIG", config, fail_if_missing=.true., do_not_log=.true.) if (trim(config) == "DOME") then - call DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, PF, tracer_Reg) + call DOME_set_OBC_data(OBC, tv, G, GV, PF, tracer_Reg) elseif (trim(config) == "USER") then - call user_set_Open_Bdry_Conds(OBC, tv, G, PF, tracer_Reg) + call user_set_OBC_data(OBC, tv, G, PF, tracer_Reg) else call MOM_error(FATAL, "The open boundary conditions specified by "//& "OBC_CONFIG = "//trim(config)//" have not been fully implemented.") call set_Open_Bdry_Conds(OBC, tv, G, GV, PF, tracer_Reg) endif + elseif (open_boundary_query(OBC, apply_orig_Flather=.true.)) then + call set_Flather_data(OBC, tv, h, G, PF, tracer_Reg) endif - - call get_param(PF, mod, "APPLY_OBC_U_FLATHER_EAST", apply_OBC_u_flather_east,& - "Apply a Flather open boundary condition on the eastern \n"//& - "side of the global domain", default=.false.) - call get_param(PF, mod, "APPLY_OBC_U_FLATHER_WEST", apply_OBC_u_flather_west,& - "Apply a Flather open boundary condition on the western \n"//& - "side of the global domain", default=.false.) - call get_param(PF, mod, "APPLY_OBC_V_FLATHER_NORTH", apply_OBC_v_flather_north,& - "Apply a Flather open boundary condition on the northern \n"//& - "side of the global domain", default=.false.) - call get_param(PF, mod, "APPLY_OBC_V_FLATHER_SOUTH", apply_OBC_v_flather_south,& - "Apply a Flather open boundary condition on the southern \n"//& - "side of the global domain", default=.false.) - if (apply_OBC_u_flather_east .or. apply_OBC_u_flather_west .or. apply_OBC_v_flather_north .or. apply_OBC_v_flather_south) then - call set_Flather_Bdry_Conds(OBC, tv, h, G, PF, tracer_Reg) + if (debug.and.associated(OBC)) then + call hchksum(G%mask2dT, 'MOM_initialize_state: mask2dT ', G%HI) + call uchksum(G%mask2dCu, 'MOM_initialize_state: mask2dCu ', G%HI) + call vchksum(G%mask2dCv, 'MOM_initialize_state: mask2dCv ', G%HI) + call qchksum(G%mask2dBu, 'MOM_initialize_state: mask2dBu ', G%HI) endif call callTree_leave('MOM_initialize_state()') @@ -1665,361 +1644,6 @@ subroutine set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tracer_Reg) end subroutine set_Open_Bdry_Conds ! ----------------------------------------------------------------------------- -! ----------------------------------------------------------------------------- -subroutine set_Flather_Bdry_Conds(OBC, tv, h, G, PF, tracer_Reg) - type(ocean_grid_type), intent(inout) :: G - type(ocean_OBC_type), pointer :: OBC - type(thermo_var_ptrs), intent(inout) :: tv - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(inout) :: h - type(param_file_type), intent(in) :: PF - type(tracer_registry_type), pointer :: tracer_Reg -! This subroutine sets the initial definitions of the characteristic open boundary -! conditions. Written by Mehmet Ilicak - -! Arguments: OBC - This open boundary condition type specifies whether, where, -! and what open boundary conditions are used. -! (out) tv - A structure containing pointers to any available -! thermodynamic fields, including potential temperature and -! salinity or mixed layer density. Absent fields have NULL ptrs. -! (in) G - The ocean's grid structure. -! (in) PF - A structure indicating the open file to parse for -! model parameter values. - - logical :: any_OBC ! Set to true if any points in this subdomain use - ! open boundary conditions. - - logical :: apply_OBC_u_flather_east = .false., apply_OBC_u_flather_west = .false. - logical :: apply_OBC_v_flather_north = .false., apply_OBC_v_flather_south = .false. - logical :: read_OBC_eta = .false. - logical :: read_OBC_uv = .false. - logical :: read_OBC_TS = .false. - - integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, nz - integer :: isd_off, jsd_off - integer :: IsdB, IedB, JsdB, JedB - integer :: east_boundary, west_boundary, north_boundary, south_boundary - character(len=40) :: mod = "set_Flather_Bdry_Conds" ! This subroutine's name. - character(len=200) :: filename, OBC_file, inputdir ! Strings for file/path - - real :: temp_u(G%domain%niglobal+1,G%domain%njglobal) - real :: temp_v(G%domain%niglobal,G%domain%njglobal+1) - - real, pointer, dimension(:,:,:) :: & - OBC_T_u => NULL(), & ! These arrays should be allocated and set to - OBC_T_v => NULL(), & ! specify the values of T and S that should come - OBC_S_u => NULL(), & - OBC_S_v => NULL() - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%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 - - call get_param(PF, mod, "APPLY_OBC_U_FLATHER_EAST", apply_OBC_u_flather_east,& - "Apply a Flather open boundary condition on the eastern \n"//& - "side of the global domain", default=.false.) - call get_param(PF, mod, "APPLY_OBC_U_FLATHER_WEST", apply_OBC_u_flather_west,& - "Apply a Flather open boundary condition on the western \n"//& - "side of the global domain", default=.false.) - call get_param(PF, mod, "APPLY_OBC_V_FLATHER_NORTH", apply_OBC_v_flather_north,& - "Apply a Flather open boundary condition on the northern \n"//& - "side of the global domain", default=.false.) - call get_param(PF, mod, "APPLY_OBC_V_FLATHER_SOUTH", apply_OBC_v_flather_south,& - "Apply a Flather open boundary condition on the southern \n"//& - "side of the global domain", default=.false.) - - if (.not.(apply_OBC_u_flather_east .or. apply_OBC_u_flather_west .or. & - apply_OBC_v_flather_north .or. apply_OBC_v_flather_south)) return - - if (.not.associated(OBC)) allocate(OBC) - - OBC%apply_OBC_u_flather_east = apply_OBC_u_flather_east - OBC%apply_OBC_u_flather_west = apply_OBC_u_flather_west - OBC%apply_OBC_v_flather_north = apply_OBC_v_flather_north - OBC%apply_OBC_v_flather_south = apply_OBC_v_flather_south - - call get_param(PF, mod, "READ_OBC_UV", read_OBC_uv, & - "If true, read the values for the velocity open boundary \n"//& - "conditions from the file specified by OBC_FILE.", & - default=.false.) - call get_param(PF, mod, "READ_OBC_ETA", read_OBC_eta, & - "If true, read the values for the sea surface height \n"//& - "open boundary conditions from the file specified by \n"//& - "OBC_FILE.", default=.false.) - call get_param(PF, mod, "READ_OBC_TS", read_OBC_TS, & - "If true, read the values for the temperature and \n"//& - "salinity open boundary conditions from the file \n"//& - "specified by OBC_FILE.", default=.false.) - if (read_OBC_uv .or. read_OBC_eta .or. read_OBC_TS) then - call get_param(PF, mod, "OBC_FILE", OBC_file, & - "The file from which the appropriate open boundary \n"//& - "condition values are read.", default="MOM_OBC_FILE.nc") - call get_param(PF, mod, "INPUTDIR", inputdir, default=".") - inputdir = slasher(inputdir) - filename = trim(inputdir)//trim(OBC_file) - call log_param(PF, mod, "INPUTDIR/OBC_FILE", filename) - endif - - if (G%symmetric) then - east_boundary = G%ieg - west_boundary = G%isg-1 - north_boundary = G%jeg - south_boundary = G%jsg-1 - else - ! I am not entirely sure that this works properly. -RWH - east_boundary = G%ieg-1 - west_boundary = G%isg - north_boundary = G%jeg-1 - south_boundary = G%jsg - endif - - if (.not.associated(OBC%OBC_mask_u)) then - allocate(OBC%OBC_mask_u(IsdB:IedB,jsd:jed)) ; OBC%OBC_mask_u(:,:) = .false. - endif - if (.not.associated(OBC%OBC_kind_u)) then - allocate(OBC%OBC_kind_u(IsdB:IedB,jsd:jed)) ; OBC%OBC_kind_u(:,:) = OBC_NONE - endif - if (.not.associated(OBC%OBC_mask_v)) then - allocate(OBC%OBC_mask_v(isd:ied,JsdB:JedB)) ; OBC%OBC_mask_v(:,:) = .false. - endif - if (.not.associated(OBC%OBC_kind_v)) then - allocate(OBC%OBC_kind_v(isd:ied,JsdB:JedB)) ; OBC%OBC_kind_v(:,:) = OBC_NONE - endif - - if (.not.associated(OBC%vbt_outer)) then - allocate(OBC%vbt_outer(isd:ied,JsdB:JedB)) ; OBC%vbt_outer(:,:) = 0.0 - endif - - if (.not.associated(OBC%ubt_outer)) then - allocate(OBC%ubt_outer(IsdB:IedB,jsd:jed)) ; OBC%ubt_outer(:,:) = 0.0 - endif - - if (.not.associated(OBC%eta_outer_u)) then - allocate(OBC%eta_outer_u(IsdB:IedB,jsd:jed)) ; OBC%eta_outer_u(:,:) = 0.0 - endif - - if (.not.associated(OBC%eta_outer_v)) then - allocate(OBC%eta_outer_v(isd:ied,JsdB:JedB)) ; OBC%eta_outer_v(:,:) = 0.0 - endif - - if (read_OBC_uv) then - call read_data(filename, 'ubt', OBC%ubt_outer, & - domain=G%Domain%mpp_domain, position=EAST_FACE) - call read_data(filename, 'vbt', OBC%vbt_outer, & - domain=G%Domain%mpp_domain, position=NORTH_FACE) - endif - - if (read_OBC_eta) then - call read_data(filename, 'eta_outer_u', OBC%eta_outer_u, & - domain=G%Domain%mpp_domain, position=EAST_FACE) - call read_data(filename, 'eta_outer_v', OBC%eta_outer_v, & - domain=G%Domain%mpp_domain, position=NORTH_FACE) - endif - - call pass_vector(OBC%eta_outer_u,OBC%eta_outer_v,G%Domain, To_All+SCALAR_PAIR, CGRID_NE) - call pass_vector(OBC%ubt_outer,OBC%vbt_outer,G%Domain) - - ! This code should be modified to allow OBCs to be applied anywhere. - - if (apply_OBC_u_flather_east) then - ! Determine where u points are applied at east side - do j=jsd,jed ; do I=IsdB,IedB - if ((I+G%idg_offset) == east_boundary) then !eastern side - if (G%mask2dCu(I,j) > 0.50) then - OBC%OBC_mask_u(I,j) = .true. - OBC%OBC_kind_u(I,j) = OBC_FLATHER_E - if (G%mask2dCv(i+1,J) > 0.50) then - OBC%OBC_mask_v(i+1,J) = .true. - if (OBC%OBC_kind_v(i+1,J) == OBC_NONE) OBC%OBC_kind_v(i+1,J) = OBC_FLATHER_E - endif - if (G%mask2dCv(i+1,J-1) > 0.50) then - OBC%OBC_mask_v(i+1,J-1) = .true. - if (OBC%OBC_kind_v(i+1,J-1) == OBC_NONE) OBC%OBC_kind_v(i+1,J-1) = OBC_FLATHER_E - endif - endif - endif - enddo ; enddo - endif - - if (apply_OBC_u_flather_west) then - ! Determine where u points are applied at west side - do j=jsd,jed ; do I=IsdB,IedB - if ((I+G%idg_offset) == west_boundary) then !western side - if (G%mask2dCu(I,j) > 0.50) then - OBC%OBC_mask_u(I,j) = .true. - OBC%OBC_kind_u(I,j) = OBC_FLATHER_W - if (G%mask2dCv(i,J) > 0.50) then - OBC%OBC_mask_v(i,J) = .true. - if (OBC%OBC_kind_v(i,J) == OBC_NONE) OBC%OBC_kind_v(i,J) = OBC_FLATHER_W - endif - if (G%mask2dCv(i,J-1) > 0.50) then - OBC%OBC_mask_v(i,J-1) = .true. - if (OBC%OBC_kind_v(i,J-1) == OBC_NONE) OBC%OBC_kind_v(i,J-1) = OBC_FLATHER_W - endif - endif - endif - enddo ; enddo - endif - - - if (apply_OBC_v_flather_north) then - ! Determine where v points are applied at north side - do J=JsdB,JedB ; do i=isd,ied - if ((J+G%jdg_offset) == north_boundary) then !northern side - if (G%mask2dCv(i,J) > 0.50) then - OBC%OBC_mask_v(i,J) = .true. - OBC%OBC_kind_v(i,J) = OBC_FLATHER_N - if (G%mask2dCu(I,j+1) > 0.50) then - OBC%OBC_mask_u(I,j+1) = .true. - if (OBC%OBC_kind_u(I,j+1) == OBC_NONE) OBC%OBC_kind_u(I,j+1) = OBC_FLATHER_N - endif - if (G%mask2dCu(I-1,j+1) > 0.50) then - OBC%OBC_mask_u(I-1,j+1) = .true. - if (OBC%OBC_kind_u(I-1,j+1) == OBC_NONE) OBC%OBC_kind_u(I-1,j+1) = OBC_FLATHER_N - endif - endif - endif - enddo ; enddo - endif - - if (apply_OBC_v_flather_south) then - ! Determine where v points are applied at south side - do J=JsdB,JedB ; do i=isd,ied - if ((J+G%jdg_offset) == south_boundary) then !southern side - if (G%mask2dCv(i,J) > 0.50) then - OBC%OBC_mask_v(i,J) = .true. - OBC%OBC_kind_v(i,J) = OBC_FLATHER_S - if (G%mask2dCu(I,j) > 0.50) then - OBC%OBC_mask_u(I,j) = .true. - if (OBC%OBC_kind_u(I,j) == OBC_NONE) OBC%OBC_kind_u(I,j) = OBC_FLATHER_S - endif - if (G%mask2dCu(I-1,j) > 0.50) then - OBC%OBC_mask_u(I-1,j) = .true. - if (OBC%OBC_kind_u(I-1,j) == OBC_NONE) OBC%OBC_kind_u(I-1,j) = OBC_FLATHER_S - endif - endif - endif - enddo ; enddo - endif - - ! If there are no OBC points on this PE, there is no reason to keep the OBC - ! type, and it could be deallocated. - - - ! Define radiation coefficients r[xy]_old_[uvh] as needed. For now, there are - ! no radiation conditions applied to the thicknesses, since the thicknesses - ! might not be physically motivated. Instead, sponges should be used to - ! enforce the near-boundary layer structure. - if (apply_OBC_u_flather_west .or. apply_OBC_u_flather_east) then - allocate(OBC%rx_old_u(IsdB:IedB,jsd:jed,nz)) ; OBC%rx_old_u(:,:,:) = 0.0 - ! allocate(OBC%rx_old_h(Isd:Ied,jsd:jed,nz)) ; OBC%rx_old_h(:,:,:) = 0.0 - endif - if (apply_OBC_v_flather_south .or. apply_OBC_v_flather_north) then - allocate(OBC%ry_old_v(isd:ied,JsdB:JedB,nz)) ; OBC%ry_old_v(:,:,:) = 0.0 - ! allocate(OBC%ry_old_h(isd:ied,Jsd:Jed,nz)) ; OBC%ry_old_h(:,:,:) = 0.0 - endif - - - if (associated(tv%T)) then - allocate(OBC_T_u(IsdB:IedB,jsd:jed,nz)) ; OBC_T_u(:,:,:) = 0.0 - allocate(OBC_S_u(IsdB:IedB,jsd:jed,nz)) ; OBC_S_u(:,:,:) = 0.0 - allocate(OBC_T_v(isd:ied,JsdB:JedB,nz)) ; OBC_T_v(:,:,:) = 0.0 - allocate(OBC_S_v(isd:ied,JsdB:JedB,nz)) ; OBC_S_v(:,:,:) = 0.0 - - if (read_OBC_TS) then - call read_data(filename, 'OBC_T_u', OBC_T_u, & - domain=G%Domain%mpp_domain, position=EAST_FACE) - call read_data(filename, 'OBC_S_u', OBC_S_u, & - domain=G%Domain%mpp_domain, position=EAST_FACE) - - call read_data(filename, 'OBC_T_v', OBC_T_v, & - domain=G%Domain%mpp_domain, position=NORTH_FACE) - call read_data(filename, 'OBC_S_v', OBC_S_v, & - domain=G%Domain%mpp_domain, position=NORTH_FACE) - else - call pass_var(tv%T, G%Domain) - call pass_var(tv%S, G%Domain) - do k=1,nz ; do j=js,je ; do I=is-1,ie - if (OBC%OBC_mask_u(I,j)) then - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) then - OBC_T_u(I,j,k) = tv%T(i,j,k) - OBC_S_u(I,j,k) = tv%S(i,j,k) - elseif (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) then - OBC_T_u(I,j,k) = tv%T(i+1,j,k) - OBC_S_u(I,j,k) = tv%S(i+1,j,k) - elseif (G%mask2dT(i,j) + G%mask2dT(i+1,j) > 0) then - OBC_T_u(I,j,k) = (G%mask2dT(i,j)*tv%T(i,j,k) + G%mask2dT(i+1,j)*tv%T(i+1,j,k)) / & - (G%mask2dT(i,j) + G%mask2dT(i+1,j)) - OBC_S_u(I,j,k) = (G%mask2dT(i,j)*tv%S(i,j,k) + G%mask2dT(i+1,j)*tv%S(i+1,j,k)) / & - (G%mask2dT(i,j) + G%mask2dT(i+1,j)) - else ! This probably shouldn't happen or maybe it doesn't matter? - OBC_T_u(I,j,k) = 0.5*(tv%T(i,j,k)+tv%T(i+1,j,k)) - OBC_S_u(I,j,k) = 0.5*(tv%S(i,j,k)+tv%S(i+1,j,k)) - endif - else - OBC_T_u(I,j,k) = 0.5*(tv%T(i,j,k)+tv%T(i+1,j,k)) - OBC_S_u(I,j,k) = 0.5*(tv%S(i,j,k)+tv%S(i+1,j,k)) - endif - enddo; enddo ; enddo - - do k=1,nz ; do J=js-1,je ; do i=is,ie - if (OBC%OBC_mask_v(i,J)) then - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) then - OBC_T_v(i,J,k) = tv%T(i,j,k) - OBC_S_v(i,J,k) = tv%S(i,j,k) - elseif (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) then - OBC_T_v(i,J,k) = tv%T(i,j+1,k) - OBC_S_v(i,J,k) = tv%S(i,j+1,k) - elseif (G%mask2dT(i,j) + G%mask2dT(i,j+1) > 0) then - OBC_T_v(i,J,k) = (G%mask2dT(i,j)*tv%T(i,j,k) + G%mask2dT(i,j+1)*tv%T(i,j+1,k)) / & - (G%mask2dT(i,j) + G%mask2dT(i,j+1)) - OBC_S_v(i,J,k) = (G%mask2dT(i,j)*tv%S(i,j,k) + G%mask2dT(i,j+1)*tv%S(i,j+1,k)) / & - (G%mask2dT(i,j) + G%mask2dT(i,j+1)) - else ! This probably shouldn't happen or maybe it doesn't matter? - OBC_T_v(i,J,k) = 0.5*(tv%T(i,j,k)+tv%T(i,j+1,k)) - OBC_S_v(i,J,k) = 0.5*(tv%S(i,j,k)+tv%S(i,j+1,k)) - endif - else - OBC_T_v(i,J,k) = 0.5*(tv%T(i,j,k)+tv%T(i,j+1,k)) - OBC_S_v(i,J,k) = 0.5*(tv%S(i,j,k)+tv%S(i,j+1,k)) - endif - enddo; enddo ; enddo - endif - - call pass_vector(OBC_T_u, OBC_T_v, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) - call pass_vector(OBC_S_u, OBC_S_v, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) - - call add_tracer_OBC_values("T", tracer_Reg, OBC_in_u=OBC_T_u, & - OBC_in_v=OBC_T_v) - call add_tracer_OBC_values("S", tracer_Reg, OBC_in_u=OBC_S_u, & - OBC_in_v=OBC_S_v) - do k=1,nz ; do j=js,je ; do I=is-1,ie - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) then - tv%T(i+1,j,k) = tv%T(i,j,k) ; tv%S(i+1,j,k) = tv%S(i,j,k) - elseif (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) then - tv%T(i,j,k) = tv%T(i+1,j,k) ; tv%S(i,j,k) = tv%S(i+1,j,k) - endif - enddo ; enddo ; enddo - do k=1,nz ; do J=js-1,je ; do i=is,ie - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) then - tv%T(i,j+1,k) = tv%T(i,j,k) ; tv%S(i,j+1,k) = tv%S(i,j,k) - elseif (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) then - tv%T(i,j,k) = tv%T(i,j+1,k) ; tv%S(i,j,k) = tv%S(i,j+1,k) - endif - enddo ; enddo ; enddo - endif - - do k=1,nz ; do j=jsd,jed ; do I=isd,ied - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) h(i+1,j,k) = h(i,j,k) - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) h(i,j,k) = h(i+1,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do J=jsd,jed ; do i=isd,ied - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) h(i,j+1,k) = h(i,j,k) - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) h(i,j,k) = h(i,j+1,k) - enddo ; enddo ; enddo - -end subroutine set_Flather_Bdry_Conds -! ----------------------------------------------------------------------------- - ! ----------------------------------------------------------------------------- subroutine set_velocity_depth_max(G) type(ocean_grid_type), intent(inout) :: G diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index ec2344f9db..d0337bcc9d 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -37,7 +37,8 @@ module DOME_initialization public DOME_initialize_topography public DOME_initialize_thickness public DOME_initialize_sponges -public DOME_set_Open_Bdry_Conds +public DOME_set_OBC_positions +public DOME_set_OBC_data contains @@ -230,12 +231,48 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) endif end subroutine DOME_initialize_sponges -! ----------------------------------------------------------------------------- -! ----------------------------------------------------------------------------- +!> Set the positions of the open boundary needed for the DOME experiment. +subroutine DOME_set_OBC_positions(G, param_file, OBC) + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(param_file_type), intent(in) :: param_file !< Parameter file handle. + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure. + ! Local variables + character(len=40) :: mod = "DOME_set_OBC_positions" ! This subroutine's name. + integer :: i, j + logical :: any_OBC ! Set to true if any points in this subdomain use OBCs + + if (.not.associated(OBC)) call MOM_error(FATAL, & + "DOME_initialization, DOME_set_OBC_positions: OBC type was not allocated!") + + any_OBC = .false. + if (OBC%apply_OBC_u) then + ! Set where u points are determined by OBCs. + !allocate(OBC_mask_u(IsdB:IedB,jsd:jed)) ; OBC_mask_u(:,:) = .false. + call MOM_error(FATAL,"DOME_initialization, DOME_set_OBC_positions: "//& + "APPLY_OBC_U=True is not coded for the DOME experiment") + endif + if (OBC%apply_OBC_v) then + ! Set where v points are determined by OBCs. + allocate(OBC%OBC_mask_v(G%isd:G%ied,G%JsdB:G%JedB)) ; OBC%OBC_mask_v(:,:) = .false. + do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + if ((G%geoLonCv(i,J) > 1000.0) .and. (G%geoLonCv(i,J) < 1100.0) .and. & + (abs(G%geoLatCv(i,J) - G%gridLatB(G%JegB)) < 0.1)) then + OBC%OBC_mask_v(i,J) = .true. + any_OBC = .true. + endif + enddo ; enddo + endif + if (.not.any_OBC) then + ! If this PE does not have any OBC points then we do not need the mask + OBC%apply_OBC_v = .false. + deallocate(OBC%OBC_mask_v) + endif +end subroutine DOME_set_OBC_positions + !> This subroutine sets the properties of flow at open boundary conditions. !! This particular example is for the DOME inflow describe in Legg et al. 2006. -subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) +subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. @@ -249,12 +286,6 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) !! to parse for model parameter values. type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry. - logical :: any_OBC ! Set to true if any points in this subdomain use - ! open boundary conditions. - logical, pointer, dimension(:,:) :: & - OBC_mask_u => NULL(), & ! These arrays are true at zonal or meridional - OBC_mask_v => NULL() ! velocity points that have prescribed open boundary - ! conditions. real, pointer, dimension(:,:,:) :: & OBC_T_u => NULL(), & ! These arrays should be allocated and set to OBC_T_v => NULL(), & ! specify the values of T and S that should come @@ -276,7 +307,7 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) ! thickness D_edge, in the same units as lat. real :: Ri_trans ! The shear Richardson number in the transition ! region of the specified shear profile. - character(len=40) :: mod = "DOME_set_Open_Bdry_Conds" ! This subroutine's name. + character(len=40) :: mod = "DOME_set_OBC_data" ! This subroutine's name. integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB @@ -289,56 +320,10 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) Ri_trans = 1.0/3.0 ! The shear Richardson number in the transition region ! region of the specified shear profile. - call get_param(param_file, mod, "APPLY_OBC_U", apply_OBC_u, & - "If true, open boundary conditions may be set at some \n"//& - "u-points, with the configuration controlled by OBC_CONFIG", & - default=.false.) - call get_param(param_file, mod, "APPLY_OBC_V", apply_OBC_v, & - "If true, open boundary conditions may be set at some \n"//& - "v-points, with the configuration controlled by OBC_CONFIG", & - default=.false.) - - if (apply_OBC_u) then - ! Determine where u points are applied. - allocate(OBC_mask_u(IsdB:IedB,jsd:jed)) ; OBC_mask_u(:,:) = .false. - any_OBC = .false. - do j=jsd,jed ; do I=IsdB,IedB - ! if (SOME_TEST_FOR_U_OPEN_BCS) then - ! OBC_mask_u(I,j) = .true. ; any_OBC = .true. - ! endif - enddo ; enddo - if (.not.any_OBC) then - ! This processor has no u points at which open boundary conditions are - ! to be applied. - apply_OBC_u = .false. - deallocate(OBC_mask_u) - endif - endif - if (apply_OBC_v) then - ! Determine where v points are applied. - allocate(OBC_mask_v(isd:ied,JsdB:JedB)) ; OBC_mask_v(:,:) = .false. - any_OBC = .false. - do J=JsdB,JedB ; do i=isd,ied - if ((G%geoLonCv(i,J) > 1000.0) .and. (G%geoLonCv(i,J) < 1100.0) .and. & - (abs(G%geoLatCv(i,J) - G%gridLatB(G%JegB)) < 0.1)) then - OBC_mask_v(i,J) = .true. ; any_OBC = .true. - endif - enddo ; enddo - if (.not.any_OBC) then - ! This processor has no v points at which open boundary conditions are - ! to be applied. - apply_OBC_v = .false. - deallocate(OBC_mask_v) - endif - endif - - if (.not.(apply_OBC_u .or. apply_OBC_v)) return - - if (.not.associated(OBC)) allocate(OBC) + if (.not.associated(OBC)) return + if (.not.(OBC%apply_OBC_u .or. OBC%apply_OBC_v)) return - if (apply_OBC_u) then - OBC%apply_OBC_u = .true. - OBC%OBC_mask_u => OBC_mask_u + if (OBC%apply_OBC_u) then allocate(OBC%u(IsdB:IedB,jsd:jed,nz)) ; OBC%u(:,:,:) = 0.0 allocate(OBC%uh(IsdB:IedB,jsd:jed,nz)) ; OBC%uh(:,:,:) = 0.0 allocate(OBC%OBC_kind_u(IsdB:IedB,jsd:jed)) ; OBC%OBC_kind_u(:,:) = OBC_NONE @@ -346,9 +331,7 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) if (OBC%OBC_mask_u(I,j)) OBC%OBC_kind_u(I,j) = OBC_SIMPLE enddo ; enddo endif - if (apply_OBC_v) then - OBC%apply_OBC_v = .true. - OBC%OBC_mask_v => OBC_mask_v + if (OBC%apply_OBC_v) then allocate(OBC%v(isd:ied,JsdB:JedB,nz)) ; OBC%v(:,:,:) = 0.0 allocate(OBC%vh(isd:ied,JsdB:JedB,nz)) ; OBC%vh(:,:,:) = 0.0 allocate(OBC%OBC_kind_v(isd:ied,JsdB:JedB)) ; OBC%OBC_kind_v(:,:) = OBC_NONE @@ -357,7 +340,7 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) enddo ; enddo endif - if (apply_OBC_v) then + if (OBC%apply_OBC_v) then g_prime_tot = (G%g_Earth/GV%Rho0)*2.0 Def_Rad = sqrt(D_edge*g_prime_tot) / (1.0e-4*1000.0) tr_0 = (-D_edge*sqrt(D_edge*g_prime_tot)*0.5e3*Def_Rad) * GV%m_to_H @@ -380,7 +363,7 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) if (k == nz) tr_k = tr_k + tr_0 * (2.0/(Ri_trans*(2.0+Ri_trans))) * & log((2.0+Ri_trans)/(2.0-Ri_trans)) do J=JsdB,JedB ; do i=isd,ied - if (OBC_mask_v(i,J)) then + if (OBC%OBC_mask_v(i,J)) then ! This needs to be unneccesarily complicated without symmetric memory. lon_im1 = 2.0*G%geoLonCv(i,J) - G%geoLonBu(I,J) ! if (isd > IsdB) lon_im1 = G%geoLonBu(I-1,J) @@ -394,9 +377,9 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) enddo endif - if (apply_OBC_u) then + if (OBC%apply_OBC_u) then do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB - if (OBC_mask_u(I,j)) then + if (OBC%OBC_mask_u(I,j)) then ! An appropriate expression for the zonal inflow velocities and ! transports should go here. OBC%uh(I,j,k) = 0.0 * GV%m_to_H ; OBC%u(I,j,k) = 0.0 @@ -408,7 +391,7 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) ! The inflow values of temperature and salinity also need to be set here if ! these variables are used. The following code is just a naive example. - if (apply_OBC_u .or. apply_OBC_v) then + if (OBC%apply_OBC_u .or. OBC%apply_OBC_v) then if (associated(tv%S)) then ! In this example, all S inflows have values of 35 psu. call add_tracer_OBC_values("S", tr_Reg, OBC_inflow=35.0) @@ -428,13 +411,13 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) do k=1,nz ; T0(k) = T0(k) + (GV%Rlay(k)-rho_guess(k)) / drho_dT(k) ; enddo enddo - if (apply_OBC_u) then + if (OBC%apply_OBC_u) then allocate(OBC_T_u(IsdB:IedB,jsd:jed,nz)) do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB OBC_T_u(I,j,k) = T0(k) enddo ; enddo ; enddo endif - if (apply_OBC_v) then + if (OBC%apply_OBC_v) then allocate(OBC_T_v(isd:ied,JsdB:JedB,nz)) do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied OBC_T_v(i,J,k) = T0(k) @@ -445,8 +428,7 @@ subroutine DOME_set_Open_Bdry_Conds(OBC, tv, G, GV, param_file, tr_Reg) endif endif -end subroutine DOME_set_Open_Bdry_Conds -! ----------------------------------------------------------------------------- +end subroutine DOME_set_OBC_data !> \class DOME_initialization !! diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 0364ef884c..33e1090617 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -40,7 +40,7 @@ module user_initialization public USER_set_coord, USER_initialize_topography, USER_initialize_thickness public USER_initialize_velocity, USER_init_temperature_salinity public USER_init_mixed_layer_density, USER_initialize_sponges -public USER_set_Open_Bdry_Conds, USER_set_rotation +public USER_set_OBC_positions, USER_set_OBC_data, USER_set_rotation logical :: first_call = .true. @@ -197,8 +197,25 @@ subroutine USER_initialize_sponges(G, use_temperature, tv, param_file, CSp, h) end subroutine USER_initialize_sponges +!> This subroutine sets the location of open boundaries. +subroutine USER_set_OBC_positions(G, param_file, OBC) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure indicating the + !! open file to parse for model + !! parameter values. + type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies + !! whether, where, and what open boundary + !! conditions are used. +! call MOM_error(FATAL, & +! "USER_initialization.F90, USER_set_OBC_positions: " // & +! "Unmodified user routine called - you must edit the routine to use it") + + if (first_call) call write_user_log(param_file) + +end subroutine USER_set_OBC_positions + !> This subroutine sets the properties of flow at open boundary conditions. -subroutine USER_set_Open_Bdry_Conds(OBC, tv, G, param_file, tr_Reg) +subroutine USER_set_OBC_data(OBC, tv, G, param_file, tr_Reg) type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type specifies !! whether, where, and what open boundary !! conditions are used. @@ -212,12 +229,12 @@ subroutine USER_set_Open_Bdry_Conds(OBC, tv, G, param_file, tr_Reg) !! parameter values. type(tracer_registry_type), pointer :: tr_Reg !< Tracer registry. ! call MOM_error(FATAL, & -! "USER_initialization.F90, USER_set_Open_Bdry_Conds: " // & +! "USER_initialization.F90, USER_set_OBC_data: " // & ! "Unmodified user routine called - you must edit the routine to use it") if (first_call) call write_user_log(param_file) -end subroutine USER_set_Open_Bdry_Conds +end subroutine USER_set_OBC_data subroutine USER_set_rotation(G, param_file) type(ocean_grid_type), intent(inout) :: G From c421b4be257b47f00d7dbabcb241ef97eae3ea98 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Fri, 17 Jun 2016 15:58:27 -0800 Subject: [PATCH 18/33] ISOMIP_tracer fix for OBC reorg. --- src/tracer/ISOMIP_tracer.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 072f5b4d87..44d985ae05 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -30,7 +30,8 @@ module ISOMIP_tracer use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_registry, only : add_tracer_diagnostics, add_tracer_OBC_values use MOM_tracer_registry, only : tracer_vertdiff -use MOM_variables, only : surface, ocean_OBC_type +use MOM_variables, only : surface +use MOM_open_boundary, only : ocean_OBC_type use MOM_verticalGrid, only : verticalGrid_type use coupler_util, only : set_coupler_values, ind_csurf From 983ce84ed1040396ee75878d00dbf5fa22f5a530 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Sat, 18 Jun 2016 13:32:33 -0800 Subject: [PATCH 19/33] Adjust OBC mask to be consistent with land mask. --- src/core/MOM_open_boundary.F90 | 30 +++++++++++++++++++ .../MOM_fixed_initialization.F90 | 4 +++ 2 files changed, 34 insertions(+) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 60768f93b0..c036da9935 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -25,6 +25,7 @@ module MOM_open_boundary public open_boundary_query public open_boundary_end public open_boundary_impose_normal_slope +public open_boundary_impose_land_mask public Radiation_Open_Bdry_Conds public set_Flather_positions public set_Flather_data @@ -235,6 +236,35 @@ subroutine open_boundary_impose_normal_slope(OBC, G, depth) end subroutine open_boundary_impose_normal_slope +!> Sets the slope of bathymetry normal to an open bounndary to zero. +subroutine open_boundary_impose_land_mask(OBC, G) + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + ! Local variables + integer :: i, j + + if (.not.associated(OBC)) return + + if (associated(OBC%OBC_kind_u)) then + do j=G%jsd,G%jed ; do I=G%isd,G%ied-1 + if (G%mask2dCu(I,j) == 0) then + OBC%OBC_kind_u(I,j) = OBC_NONE + OBC%OBC_mask_u(I,j) = .false. + endif + enddo ; enddo + endif + + if (associated(OBC%OBC_kind_v)) then + do J=G%jsd,G%jed-1 ; do i=G%isd,G%ied + if (G%mask2dCv(i,J) == 0) then + OBC%OBC_kind_v(i,J) = OBC_NONE + OBC%OBC_mask_v(i,J) = .false. + endif + enddo ; enddo + endif + +end subroutine open_boundary_impose_land_mask + !> Diagnose radiation conditions at open boundaries subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & h_new, h_old, G) diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index fd31128063..b6f10bfaec 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -21,6 +21,7 @@ module MOM_fixed_initialization use MOM_open_boundary, only : ocean_OBC_type use MOM_open_boundary, only : open_boundary_config, open_boundary_query use MOM_open_boundary, only : set_Flather_positions, open_boundary_impose_normal_slope +use MOM_open_boundary, only : open_boundary_impose_land_mask use MOM_string_functions, only : uppercase use user_initialization, only : user_initialize_topography, USER_set_OBC_positions use DOME_initialization, only : DOME_initialize_topography, DOME_set_OBC_positions @@ -112,6 +113,9 @@ subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir) ! This call sets masks that prohibit flow over any point interpreted as land call initialize_masks(G, PF) + + ! Make OBC mask consistent with land mask + call open_boundary_impose_land_mask(OBC, G) if (debug) then call hchksum(G%bathyT, 'MOM_initialize_fixed: depth ', G%HI, haloshift=1) call hchksum(G%mask2dT, 'MOM_initialize_fixed: mask2dT ', G%HI) From c3c1106377efc414dac392a29ec2719741f4b130 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Sun, 19 Jun 2016 11:03:59 -0400 Subject: [PATCH 20/33] Split OBC_kind_u into OBC_kind_u and OBC_direction_u - OBC_kind_u/v used to indicate whether an open boundary was OBC_SIMPLE or OBC_FLATHER_* and if the latter would also indicate the outward direction. This was not extensible and also made rational reconciliation of masks awkward. - OBC_kind_u/v can now be only OBC_NONE, OBC_SIMPLE, OBC_FLATHER and OBC_direction_u/v has been introduced to indicate outward direction. Although direction is not needed for OBC_SIMPLE it does no harm AND it does help when generalizing the setup that needs to know which side of the open boundary bathymetry could be altered. - No answer changes. --- src/core/MOM_barotropic.F90 | 180 +++++++------- src/core/MOM_continuity_PPM.F90 | 20 +- src/core/MOM_legacy_barotropic.F90 | 232 ++++++++++-------- src/core/MOM_open_boundary.F90 | 116 ++++++--- .../lateral/MOM_hor_visc.F90 | 9 +- src/tracer/MOM_tracer_advect.F90 | 12 +- src/tracer/MOM_tracer_hor_diff.F90 | 2 - src/user/DOME_initialization.F90 | 2 + src/user/user_initialization.F90 | 4 +- 9 files changed, 322 insertions(+), 255 deletions(-) diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index a359a9f90f..3fb030c3ce 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -105,9 +105,9 @@ module MOM_barotropic use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_io, only : vardesc, var_desc -use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE, OBC_NONE -use MOM_open_boundary, only : OBC_FLATHER_E, OBC_FLATHER_W -use MOM_open_boundary, only : OBC_FLATHER_N, OBC_FLATHER_S +use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE, OBC_NONE, OBC_FLATHER +use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W +use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_tidal_forcing, only : tidal_forcing_sensitivity, tidal_forcing_CS use MOM_time_manager, only : time_type, set_time, operator(+), operator(-) @@ -362,6 +362,8 @@ module MOM_barotropic OBC_mask_u => NULL(), & OBC_mask_v => NULL() integer, dimension(:,:), pointer :: & + OBC_direction_u => NULL(), & + OBC_direction_v => NULL(), & OBC_kind_u => NULL(), & OBC_kind_v => NULL() real, dimension(:,:), pointer :: & @@ -2378,44 +2380,46 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, uhbt(I,j) = BT_OBC%uhbt(I,j) ubt(I,j) = BT_OBC%ubt_outer(I,j) vel_trans = ubt(I,j) - elseif (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) then - cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL - u_inlet = cfl*ubt_old(I-1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1 - ! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i+1,j) ! external - h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j)) ! internal - - H_u = BT_OBC%H_u(I,j) - vel_prev = ubt(I,j) - ubt(I,j) = 0.5*((u_inlet + BT_OBC%ubt_outer(I,j)) + & - (BT_OBC%Cg_u(I,j)/H_u) * (h_in-BT_OBC%eta_outer_u(I,j))) - - vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j) - elseif (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) then - cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL - u_inlet = cfl*ubt_old(I+1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1 - ! h_in = 2.0*cfl*eta(i+1,j) + (1.0-2.0*cfl)*eta(i,j) ! external - h_in = eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j)) ! internal - - H_u = BT_OBC%H_u(I,j) - vel_prev = ubt(I,j) - ubt(I,j) = 0.5*((u_inlet+BT_OBC%ubt_outer(I,j)) + & - (BT_OBC%Cg_u(I,j)/H_u) * (BT_OBC%eta_outer_u(I,j)-h_in)) - - vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j) - elseif (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER_N) then - if ((vbt(i,J-1)+vbt(i+1,J-1)) > 0.0) then - ubt(I,j) = 2.0*ubt(I,j-1)-ubt(I,j-2) - else - ubt(I,j) = BT_OBC%ubt_outer(I,j) - endif - vel_trans = ubt(I,j) - elseif (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER_S) then - if ((vbt(i,J)+vbt(i+1,J)) > 0.0) then - ubt(I,j) = 2.0*ubt(I,j+1)-ubt(I,j+2) - else - ubt(I,j) = BT_OBC%ubt_outer(I,j) + elseif (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER) then + if (BT_OBC%OBC_direction_u(I,j) == OBC_DIRECTION_E) then + cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL + u_inlet = cfl*ubt_old(I-1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1 + ! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i+1,j) ! external + h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j)) ! internal + + H_u = BT_OBC%H_u(I,j) + vel_prev = ubt(I,j) + ubt(I,j) = 0.5*((u_inlet + BT_OBC%ubt_outer(I,j)) + & + (BT_OBC%Cg_u(I,j)/H_u) * (h_in-BT_OBC%eta_outer_u(I,j))) + + vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j) + elseif (BT_OBC%OBC_direction_u(I,j) == OBC_DIRECTION_W) then + cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL + u_inlet = cfl*ubt_old(I+1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1 + ! h_in = 2.0*cfl*eta(i+1,j) + (1.0-2.0*cfl)*eta(i,j) ! external + h_in = eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j)) ! internal + + H_u = BT_OBC%H_u(I,j) + vel_prev = ubt(I,j) + ubt(I,j) = 0.5*((u_inlet+BT_OBC%ubt_outer(I,j)) + & + (BT_OBC%Cg_u(I,j)/H_u) * (BT_OBC%eta_outer_u(I,j)-h_in)) + + vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j) + elseif (BT_OBC%OBC_direction_u(I,j) == OBC_DIRECTION_N) then + if ((vbt(i,J-1)+vbt(i+1,J-1)) > 0.0) then + ubt(I,j) = 2.0*ubt(I,j-1)-ubt(I,j-2) + else + ubt(I,j) = BT_OBC%ubt_outer(I,j) + endif + vel_trans = ubt(I,j) + elseif (BT_OBC%OBC_direction_u(I,j) == OBC_DIRECTION_S) then + if ((vbt(i,J)+vbt(i+1,J)) > 0.0) then + ubt(I,j) = 2.0*ubt(I,j+1)-ubt(I,j+2) + else + ubt(I,j) = BT_OBC%ubt_outer(I,j) + endif + vel_trans = ubt(I,j) endif - vel_trans = ubt(I,j) endif if (BT_OBC%OBC_kind_u(I,j) /= OBC_SIMPLE) then @@ -2436,52 +2440,54 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, vhbt(i,J) = BT_OBC%vhbt(i,J) vbt(i,J) = BT_OBC%vbt_outer(i,J) vel_trans = vbt(i,J) - elseif (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) then - cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL - v_inlet = cfl*vbt_old(i,J-1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl<1 - ! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i,j+1) ! external - h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1)) ! internal - - H_v = BT_OBC%H_v(i,J) - vel_prev = vbt(i,J) - vbt(i,J) = 0.5*((v_inlet+BT_OBC%vbt_outer(i,J)) + & - (BT_OBC%Cg_v(i,J)/H_v) * (h_in-BT_OBC%eta_outer_v(i,J))) - - vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J) - elseif (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) then - cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL - v_inlet = cfl*vbt_old(i,J+1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl <1 - ! h_in = 2.0*cfl*eta(i,j+1) + (1.0-2.0*cfl)*eta(i,j) ! external - h_in = eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2)) ! internal - - H_v = BT_OBC%H_v(i,J) - vel_prev = vbt(i,J) - vbt(i,J) = 0.5*((v_inlet+BT_OBC%vbt_outer(i,J)) + & - (BT_OBC%Cg_v(i,J)/H_v) * (BT_OBC%eta_outer_v(i,J)-h_in)) - - vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J) - elseif (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER_E) then - if ((ubt(I-1,j)+ubt(I-1,j+1)) > 0.0) then - vbt(i,J) = 2.0*vbt(i-1,J)-vbt(i-2,J) - else - vbt(i,J) = BT_OBC%vbt_outer(i,J) - endif - vel_trans = vbt(i,J) + elseif (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER) then + if (BT_OBC%OBC_direction_v(i,J) == OBC_DIRECTION_N) then + cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL + v_inlet = cfl*vbt_old(i,J-1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl<1 + ! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i,j+1) ! external + h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1)) ! internal + + H_v = BT_OBC%H_v(i,J) + vel_prev = vbt(i,J) + vbt(i,J) = 0.5*((v_inlet+BT_OBC%vbt_outer(i,J)) + & + (BT_OBC%Cg_v(i,J)/H_v) * (h_in-BT_OBC%eta_outer_v(i,J))) + + vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J) + elseif (BT_OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S) then + cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL + v_inlet = cfl*vbt_old(i,J+1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl <1 + ! h_in = 2.0*cfl*eta(i,j+1) + (1.0-2.0*cfl)*eta(i,j) ! external + h_in = eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2)) ! internal + + H_v = BT_OBC%H_v(i,J) + vel_prev = vbt(i,J) + vbt(i,J) = 0.5*((v_inlet+BT_OBC%vbt_outer(i,J)) + & + (BT_OBC%Cg_v(i,J)/H_v) * (BT_OBC%eta_outer_v(i,J)-h_in)) + + vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J) + elseif (BT_OBC%OBC_direction_v(i,J) == OBC_DIRECTION_E) then + if ((ubt(I-1,j)+ubt(I-1,j+1)) > 0.0) then + vbt(i,J) = 2.0*vbt(i-1,J)-vbt(i-2,J) + else + vbt(i,J) = BT_OBC%vbt_outer(i,J) + endif + vel_trans = vbt(i,J) !!!!!!!!!!!!!!!!!!! CLAMPED !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(i,J) ! ! vbt(i,J) = (vbt(i-1,J) + CFL*vbt(i,J)) / (1.0 + CFL) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - elseif (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER_W) then - if ((ubt(I,j)+ubt(I,j+1)) < 0.0) then - vbt(i,J) = 2.0*vbt(i+1,J)-vbt(i+2,J) - else - vbt(i,J) = BT_OBC%vbt_outer(i,J) - endif - vel_trans = vbt(i,J) + elseif (BT_OBC%OBC_direction_v(i,J) == OBC_DIRECTION_W) then + if ((ubt(I,j)+ubt(I,j+1)) < 0.0) then + vbt(i,J) = 2.0*vbt(i+1,J)-vbt(i+2,J) + else + vbt(i,J) = BT_OBC%vbt_outer(i,J) + endif + vel_trans = vbt(i,J) !!!!!!!!!!!!!!!!!! CLAMPED !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(i,J) ! ! vbt(i,J) = (vbt(i-1,J) + CFL*vbt(i,J)) / (1.0 + CFL) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + endif endif if (BT_OBC%OBC_kind_v(i,J) /= OBC_SIMPLE) then @@ -2532,8 +2538,8 @@ subroutine apply_eta_OBCs(OBC, eta, ubt, vbt, BT_OBC, G, MS, halo, dtbt) if ((OBC%apply_OBC_u_flather_east .or. OBC%apply_OBC_u_flather_west) .and. & associated(BT_OBC%OBC_mask_u)) then - do j=js,je ; do I=is-1,ie ; if (BT_OBC%OBC_mask_u(I,j)) then - if (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) then + do j=js,je ; do I=is-1,ie ; if (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER) then + if (BT_OBC%OBC_direction_u(I,j) == OBC_DIRECTION_E) then cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL u_inlet = cfl*ubt(I-1,j) + (1.0-cfl)*ubt(I,j) ! Valid for cfl <1 ! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i+1,j) ! external @@ -2542,7 +2548,7 @@ subroutine apply_eta_OBCs(OBC, eta, ubt, vbt, BT_OBC, G, MS, halo, dtbt) H_u = BT_OBC%H_u(I,j) eta(i+1,j) = 2.0 * 0.5*((BT_OBC%eta_outer_u(I,j)+h_in) + & (H_u/BT_OBC%Cg_u(I,j))*(u_inlet-BT_OBC%ubt_outer(I,j))) - eta(i,j) - elseif (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) then + elseif (BT_OBC%OBC_direction_u(I,j) == OBC_DIRECTION_W) then cfl = dtbt*BT_OBC%Cg_u(I,j)*G%IdxCu(I,j) ! CFL u_inlet = cfl*ubt(I+1,j) + (1.0-cfl)*ubt(I,j) ! Valid for cfl <1 ! h_in = 2.0*cfl*eta(i+1,j) + (1.0-2.0*cfl)*eta(i,j) ! external @@ -2557,8 +2563,8 @@ subroutine apply_eta_OBCs(OBC, eta, ubt, vbt, BT_OBC, G, MS, halo, dtbt) if ((OBC%apply_OBC_v_flather_north .or. OBC%apply_OBC_v_flather_south) .and. & associated(BT_OBC%OBC_mask_v)) then - do J=js-1,je ; do i=is,ie ; if (BT_OBC%OBC_mask_v(i,J)) then - if (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) then + do J=js-1,je ; do i=is,ie ; if (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER) then + if (BT_OBC%OBC_direction_v(i,J) == OBC_DIRECTION_N) then cfl = dtbt*BT_OBC%Cg_v(i,J)*G%IdyCv(i,J) ! CFL v_inlet = cfl*vbt(i,J-1) + (1.0-cfl)*vbt(i,J) ! Valid for cfl <1 ! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i,j+1) ! external @@ -2567,7 +2573,7 @@ subroutine apply_eta_OBCs(OBC, eta, ubt, vbt, BT_OBC, G, MS, halo, dtbt) H_v = BT_OBC%H_v(i,J) eta(i,j+1) = 2.0 * 0.5*((BT_OBC%eta_outer_v(i,J)+h_in) + & (H_v/BT_OBC%Cg_v(i,J))*(v_inlet-BT_OBC%vbt_outer(i,J))) - eta(i,j) - elseif (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) then + elseif (BT_OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S) then cfl = dtbt*BT_OBC%Cg_v(i,J)*G%IdyCv(i,J) ! CFL v_inlet = cfl*vbt(i,J+1) + (1.0-cfl)*vbt(i,J) ! Valid for cfl <1 ! h_in = 2.0*cfl*eta(i,j+1) + (1.0-2.0*cfl)*eta(i,j) ! external @@ -2635,6 +2641,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, G, GV, MS, halo, use_BT_cont, Datu, D allocate(BT_OBC%eta_outer_u(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%eta_outer_u(:,:) = 0.0 allocate(BT_OBC%OBC_mask_u(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%OBC_mask_u(:,:)=.false. allocate(BT_OBC%OBC_kind_u(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%OBC_kind_u(:,:)=OBC_NONE + allocate(BT_OBC%OBC_direction_u(isdw-1:iedw,jsdw:jedw)); BT_OBC%OBC_direction_u(:,:)=OBC_NONE allocate(BT_OBC%Cg_v(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%Cg_v(:,:) = 0.0 allocate(BT_OBC%H_v(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%H_v(:,:) = 0.0 @@ -2643,11 +2650,13 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, G, GV, MS, halo, use_BT_cont, Datu, D allocate(BT_OBC%eta_outer_v(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%eta_outer_v(:,:)=0.0 allocate(BT_OBC%OBC_mask_v(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%OBC_mask_v(:,:)=.false. allocate(BT_OBC%OBC_kind_v(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%OBC_kind_v(:,:)=OBC_NONE + allocate(BT_OBC%OBC_direction_v(isdw-1:iedw,jsdw:jedw)); BT_OBC%OBC_direction_v(:,:)=OBC_NONE if (associated(OBC%OBC_mask_u)) then do j=js-1,je+1 ; do I=is-1,ie BT_OBC%OBC_mask_u(I,j) = OBC%OBC_mask_u(I,j) BT_OBC%OBC_kind_u(I,j) = OBC%OBC_kind_u(I,j) + BT_OBC%OBC_direction_u(I,j) = OBC%OBC_direction_u(I,j) enddo ; enddo if (OBC%apply_OBC_u) then do k=1,nz ; do j=js,je ; do I=is-1,ie @@ -2683,6 +2692,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, G, GV, MS, halo, use_BT_cont, Datu, D do J=js-1,je ; do i=is-1,ie+1 BT_OBC%OBC_mask_v(i,J) = OBC%OBC_mask_v(i,J) BT_OBC%OBC_kind_v(i,J) = OBC%OBC_kind_v(i,J) + BT_OBC%OBC_direction_v(i,J) = OBC%OBC_direction_v(i,J) enddo ; enddo if (OBC%apply_OBC_v) then do k=1,nz ; do J=js-1,je ; do i=is,ie @@ -2732,6 +2742,7 @@ subroutine destroy_BT_OBC(BT_OBC) if (associated(BT_OBC%OBC_mask_u)) deallocate(BT_OBC%OBC_mask_u) if (associated(BT_OBC%OBC_kind_u)) deallocate(BT_OBC%OBC_kind_u) + if (associated(BT_OBC%OBC_direction_u)) deallocate(BT_OBC%OBC_direction_u) deallocate(BT_OBC%Cg_u) deallocate(BT_OBC%H_u) deallocate(BT_OBC%uhbt) @@ -2740,6 +2751,7 @@ subroutine destroy_BT_OBC(BT_OBC) if (associated(BT_OBC%OBC_mask_v)) deallocate(BT_OBC%OBC_mask_v) if (associated(BT_OBC%OBC_kind_v)) deallocate(BT_OBC%OBC_kind_v) + if (associated(BT_OBC%OBC_direction_v)) deallocate(BT_OBC%OBC_direction_v) deallocate(BT_OBC%Cg_v) deallocate(BT_OBC%H_v) deallocate(BT_OBC%vhbt) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 8a31121f1c..2562ca995f 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -48,8 +48,8 @@ module MOM_continuity_PPM 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 -use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE -use MOM_open_boundary, only : OBC_FLATHER_E, OBC_FLATHER_W, OBC_FLATHER_N, OBC_FLATHER_S +use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE, OBC_FLATHER +use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_variables, only : BT_cont_type use MOM_verticalGrid, only : verticalGrid_type @@ -229,11 +229,11 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, if (apply_OBC_u_flather_east .or. apply_OBC_u_flather_west) then do k=1,nz ; do j=LB%jsh,LB%jeh do I=LB%ish,LB%ieh+1 - if (OBC%OBC_mask_u(I-1,j) .and. (OBC%OBC_kind_u(I-1,j) == OBC_FLATHER_E)) & + if (OBC%OBC_kind_u(I-1,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I-1,j) == OBC_DIRECTION_E)) & h(i,j,k) = h_input(i-1,j,k) enddo do i=LB%ish-1,LB%ieh - if (OBC%OBC_mask_u(I,j) .and. (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W)) & + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_W)) & h(i,j,k) = h_input(i+1,j,k) enddo enddo ; enddo @@ -257,11 +257,11 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, if (apply_OBC_v_flather_north .or. apply_OBC_v_flather_south) then do k=1,nz do J=LB%jsh,LB%jeh+1 ; do i=LB%ish-1,LB%ieh+1 - if (OBC%OBC_mask_v(i,J-1) .and. (OBC%OBC_kind_v(i,J-1) == OBC_FLATHER_N)) & + if (OBC%OBC_kind_v(i,J-1) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J-1) == OBC_DIRECTION_N)) & h(i,j,k) = h_input(i,j-1,k) enddo ; enddo do J=LB%jsh-1,LB%jeh ; do i=LB%ish-1,LB%ieh+1 - if (OBC%OBC_mask_v(i,J) .and. (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S)) & + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S)) & h(i,j,k) = h_input(i,j+1,k) enddo ; enddo enddo @@ -284,11 +284,11 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, if (apply_OBC_v_flather_north .or. apply_OBC_v_flather_south) then do k=1,nz do J=LB%jsh,LB%jeh+1 ; do i=LB%ish-1,LB%ieh+1 - if (OBC%OBC_mask_v(i,J-1) .and. (OBC%OBC_kind_v(i,J-1) == OBC_FLATHER_N)) & + if (OBC%OBC_kind_v(i,J-1) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J-1) == OBC_DIRECTION_N)) & h(i,j,k) = h_input(i,j-1,k) enddo ; enddo do J=LB%jsh-1,LB%jeh ; do i=LB%ish-1,LB%ieh+1 - if (OBC%OBC_mask_v(i,J) .and. (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S)) & + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S)) & h(i,j,k) = h_input(i,j+1,k) enddo ; enddo enddo @@ -312,11 +312,11 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, if (apply_OBC_u_flather_east .or. apply_OBC_u_flather_west) then do k=1,nz ; do j=LB%jsh,LB%jeh do I=LB%ish,LB%ieh+1 - if (OBC%OBC_mask_u(I-1,j) .and. (OBC%OBC_kind_u(I-1,j) == OBC_FLATHER_E)) & + if (OBC%OBC_kind_u(I-1,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I-1,j) == OBC_DIRECTION_E)) & h(i,j,k) = h_input(i-1,j,k) enddo do i=LB%ish-1,LB%ieh - if (OBC%OBC_mask_u(I,j) .and. (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W)) & + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_W)) & h(i,j,k) = h_input(i+1,j,k) enddo enddo ; enddo diff --git a/src/core/MOM_legacy_barotropic.F90 b/src/core/MOM_legacy_barotropic.F90 index c6f077ec6a..d8232d1b77 100644 --- a/src/core/MOM_legacy_barotropic.F90 +++ b/src/core/MOM_legacy_barotropic.F90 @@ -107,9 +107,9 @@ module MOM_legacy_barotropic use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_io, only : vardesc, var_desc -use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE, OBC_NONE -use MOM_open_boundary, only : OBC_FLATHER_E, OBC_FLATHER_W -use MOM_open_boundary, only : OBC_FLATHER_N, OBC_FLATHER_S +use MOM_open_boundary, only : ocean_OBC_type, OBC_SIMPLE, OBC_NONE, OBC_FLATHER +use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W +use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_tidal_forcing, only : tidal_forcing_sensitivity, tidal_forcing_CS use MOM_time_manager, only : time_type, set_time, operator(+), operator(-) @@ -352,6 +352,8 @@ module MOM_legacy_barotropic OBC_mask_u => NULL(), & OBC_mask_v => NULL() integer, dimension(:,:), pointer :: & + OBC_direction_u => NULL(), & + OBC_direction_v => NULL(), & OBC_kind_u => NULL(), & OBC_kind_v => NULL() real, dimension(:,:), pointer :: & @@ -2236,44 +2238,46 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, uhbt(I,j) = BT_OBC%uhbt(I,j) ubt(I,j) = BT_OBC%ubt_outer(I,j) vel_trans = ubt(I,j) - elseif (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) then - cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL - u_inlet = cfl*ubt_old(I-1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1 - ! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i+1,j) ! external - h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j)) ! internal + elseif (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER) then + if (BT_OBC%OBC_direction_u(I,j) == OBC_DIRECTION_E) then + cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL + u_inlet = cfl*ubt_old(I-1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1 + ! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i+1,j) ! external + h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j)) ! internal + + H_u = BT_OBC%H_u(I,j) + vel_prev = ubt(I,j) + ubt(I,j) = 0.5*((u_inlet + BT_OBC%ubt_outer(I,j)) + & + (BT_OBC%Cg_u(I,j)/H_u) * (h_in-BT_OBC%eta_outer_u(I,j))) - H_u = BT_OBC%H_u(I,j) - vel_prev = ubt(I,j) - ubt(I,j) = 0.5*((u_inlet + BT_OBC%ubt_outer(I,j)) + & - (BT_OBC%Cg_u(I,j)/H_u) * (h_in-BT_OBC%eta_outer_u(I,j))) - - vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j) - elseif (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) then - cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL - u_inlet = cfl*ubt_old(I+1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1 - ! h_in = 2.0*cfl*eta(i+1,j) + (1.0-2.0*cfl)*eta(i,j) ! external - h_in = eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j)) ! internal + vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j) + elseif (BT_OBC%OBC_direction_u(I,j) == OBC_DIRECTION_W) then + cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL + u_inlet = cfl*ubt_old(I+1,j) + (1.0-cfl)*ubt_old(I,j) ! Valid for cfl<1 + ! h_in = 2.0*cfl*eta(i+1,j) + (1.0-2.0*cfl)*eta(i,j) ! external + h_in = eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j)) ! internal - H_u = BT_OBC%H_u(I,j) - vel_prev = ubt(I,j) - ubt(I,j) = 0.5*((u_inlet+BT_OBC%ubt_outer(I,j)) + & - (BT_OBC%Cg_u(I,j)/H_u) * (BT_OBC%eta_outer_u(I,j)-h_in)) + H_u = BT_OBC%H_u(I,j) + vel_prev = ubt(I,j) + ubt(I,j) = 0.5*((u_inlet+BT_OBC%ubt_outer(I,j)) + & + (BT_OBC%Cg_u(I,j)/H_u) * (BT_OBC%eta_outer_u(I,j)-h_in)) - vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j) - elseif (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER_N) then - if ((vbt(i,J-1)+vbt(i+1,J-1)) > 0.0) then - ubt(I,j) = 2.0*ubt(I,j-1)-ubt(I,j-2) - else - ubt(I,j) = BT_OBC%ubt_outer(I,j) - endif - vel_trans = ubt(I,j) - elseif (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER_S) then - if ((vbt(i,J)+vbt(i+1,J)) > 0.0) then - ubt(I,j) = 2.0*ubt(I,j+1)-ubt(I,j+2) - else - ubt(I,j) = BT_OBC%ubt_outer(I,j) + vel_trans = (1.0-bebt)*vel_prev + bebt*ubt(I,j) + elseif (BT_OBC%OBC_direction_u(I,j) == OBC_DIRECTION_N) then + if ((vbt(i,J-1)+vbt(i+1,J-1)) > 0.0) then + ubt(I,j) = 2.0*ubt(I,j-1)-ubt(I,j-2) + else + ubt(I,j) = BT_OBC%ubt_outer(I,j) + endif + vel_trans = ubt(I,j) + elseif (BT_OBC%OBC_direction_u(I,j) == OBC_DIRECTION_S) then + if ((vbt(i,J)+vbt(i+1,J)) > 0.0) then + ubt(I,j) = 2.0*ubt(I,j+1)-ubt(I,j+2) + else + ubt(I,j) = BT_OBC%ubt_outer(I,j) + endif + vel_trans = ubt(I,j) endif - vel_trans = ubt(I,j) endif if (BT_OBC%OBC_kind_u(I,j) /= OBC_SIMPLE) then @@ -2294,52 +2298,54 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, vhbt(i,J) = BT_OBC%vhbt(i,J) vbt(i,J) = BT_OBC%vbt_outer(i,J) vel_trans = vbt(i,J) - elseif (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) then - cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL - v_inlet = cfl*vbt_old(i,J-1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl<1 - ! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i,j+1) ! external - h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1)) ! internal - - H_v = BT_OBC%H_v(i,J) - vel_prev = vbt(i,J) - vbt(i,J) = 0.5*((v_inlet+BT_OBC%vbt_outer(i,J)) + & - (BT_OBC%Cg_v(i,J)/H_v) * (h_in-BT_OBC%eta_outer_v(i,J))) + elseif (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER) then + if (BT_OBC%OBC_direction_v(i,J) == OBC_DIRECTION_N) then + cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL + v_inlet = cfl*vbt_old(i,J-1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl<1 + ! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i,j+1) ! external + h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1)) ! internal + + H_v = BT_OBC%H_v(i,J) + vel_prev = vbt(i,J) + vbt(i,J) = 0.5*((v_inlet+BT_OBC%vbt_outer(i,J)) + & + (BT_OBC%Cg_v(i,J)/H_v) * (h_in-BT_OBC%eta_outer_v(i,J))) - vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J) - elseif (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) then - cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL - v_inlet = cfl*vbt_old(i,J+1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl <1 - ! h_in = 2.0*cfl*eta(i,j+1) + (1.0-2.0*cfl)*eta(i,j) ! external - h_in = eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2)) ! internal + vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J) + elseif (BT_OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S) then + cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(I,j) ! CFL + v_inlet = cfl*vbt_old(i,J+1) + (1.0-cfl)*vbt_old(i,J) ! Valid for cfl <1 + ! h_in = 2.0*cfl*eta(i,j+1) + (1.0-2.0*cfl)*eta(i,j) ! external + h_in = eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2)) ! internal - H_v = BT_OBC%H_v(i,J) - vel_prev = vbt(i,J) - vbt(i,J) = 0.5*((v_inlet+BT_OBC%vbt_outer(i,J)) + & - (BT_OBC%Cg_v(i,J)/H_v) * (BT_OBC%eta_outer_v(i,J)-h_in)) + H_v = BT_OBC%H_v(i,J) + vel_prev = vbt(i,J) + vbt(i,J) = 0.5*((v_inlet+BT_OBC%vbt_outer(i,J)) + & + (BT_OBC%Cg_v(i,J)/H_v) * (BT_OBC%eta_outer_v(i,J)-h_in)) - vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J) - elseif (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER_E) then - if ((ubt(I-1,j)+ubt(I-1,j+1)) > 0.0) then - vbt(i,J) = 2.0*vbt(i-1,J)-vbt(i-2,J) - else - vbt(i,J) = BT_OBC%vbt_outer(i,J) - endif - vel_trans = vbt(i,J) + vel_trans = (1.0-bebt)*vel_prev + bebt*vbt(i,J) + elseif (BT_OBC%OBC_direction_v(i,J) == OBC_DIRECTION_E) then + if ((ubt(I-1,j)+ubt(I-1,j+1)) > 0.0) then + vbt(i,J) = 2.0*vbt(i-1,J)-vbt(i-2,J) + else + vbt(i,J) = BT_OBC%vbt_outer(i,J) + endif + vel_trans = vbt(i,J) !!!!!!!!!!!!!!!!!!! CLAMPED !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(i,J) ! ! vbt(i,J) = (vbt(i-1,J) + CFL*vbt(i,J)) / (1.0 + CFL) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - elseif (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER_W) then - if ((ubt(I,j)+ubt(I,j+1)) < 0.0) then - vbt(i,J) = 2.0*vbt(i+1,J)-vbt(i+2,J) - else - vbt(i,J) = BT_OBC%vbt_outer(i,J) - endif - vel_trans = vbt(i,J) + elseif (BT_OBC%OBC_direction_v(i,J) == OBC_DIRECTION_W) then + if ((ubt(I,j)+ubt(I,j+1)) < 0.0) then + vbt(i,J) = 2.0*vbt(i+1,J)-vbt(i+2,J) + else + vbt(i,J) = BT_OBC%vbt_outer(i,J) + endif + vel_trans = vbt(i,J) !!!!!!!!!!!!!!!!!! CLAMPED !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! cfl = dtbt * BT_OBC%Cg_v(i,J) * G%IdyCv(i,J) ! ! vbt(i,J) = (vbt(i-1,J) + CFL*vbt(i,J)) / (1.0 + CFL) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + endif endif if (BT_OBC%OBC_kind_v(i,J) /= OBC_SIMPLE) then @@ -2391,24 +2397,26 @@ subroutine apply_eta_OBCs(OBC, eta, ubt, vbt, BT_OBC, G, MS, halo, dtbt) if ((OBC%apply_OBC_u_flather_east .or. OBC%apply_OBC_u_flather_west) .and. & associated(BT_OBC%OBC_mask_u)) then do j=js,je ; do I=is-1,ie ; if (BT_OBC%OBC_mask_u(I,j)) then - if (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) then - cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL - u_inlet = cfl*ubt(I-1,j) + (1.0-cfl)*ubt(I,j) ! Valid for cfl <1 -! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i+1,j) ! external - h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j)) ! internal - - H_u = BT_OBC%H_u(I,j) - eta(i+1,j) = 2.0 * 0.5*((BT_OBC%eta_outer_u(I,j)+h_in) + & - (H_u/BT_OBC%Cg_u(I,j))*(u_inlet-BT_OBC%ubt_outer(I,j))) - eta(i,j) - elseif (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) then - cfl = dtbt*BT_OBC%Cg_u(I,j)*G%IdxCu(I,j) ! CFL - u_inlet = cfl*ubt(I+1,j) + (1.0-cfl)*ubt(I,j) ! Valid for cfl <1 -! h_in = 2.0*cfl*eta(i+1,j) + (1.0-2.0*cfl)*eta(i,j) ! external - h_in = eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j)) ! internal - - H_u = BT_OBC%H_u(I,j) - eta(i,j) = 2.0 * 0.5*((BT_OBC%eta_outer_u(I,j)+h_in) + & - (H_u/BT_OBC%Cg_u(I,j))*(BT_OBC%ubt_outer(I,j)-u_inlet)) - eta(i+1,j) + if (BT_OBC%OBC_kind_u(I,j) == OBC_FLATHER) then + if (BT_OBC%OBC_direction_u(I,j) == OBC_DIRECTION_E) then + cfl = dtbt * BT_OBC%Cg_u(I,j) * G%IdxCu(I,j) ! CFL + u_inlet = cfl*ubt(I-1,j) + (1.0-cfl)*ubt(I,j) ! Valid for cfl <1 +! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i+1,j) ! external + h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i-1,j)) ! internal + + H_u = BT_OBC%H_u(I,j) + eta(i+1,j) = 2.0 * 0.5*((BT_OBC%eta_outer_u(I,j)+h_in) + & + (H_u/BT_OBC%Cg_u(I,j))*(u_inlet-BT_OBC%ubt_outer(I,j))) - eta(i,j) + elseif (BT_OBC%OBC_direction_u(I,j) == OBC_DIRECTION_W) then + cfl = dtbt*BT_OBC%Cg_u(I,j)*G%IdxCu(I,j) ! CFL + u_inlet = cfl*ubt(I+1,j) + (1.0-cfl)*ubt(I,j) ! Valid for cfl <1 +! h_in = 2.0*cfl*eta(i+1,j) + (1.0-2.0*cfl)*eta(i,j) ! external + h_in = eta(i+1,j) + (0.5-cfl)*(eta(i+1,j)-eta(i+2,j)) ! internal + + H_u = BT_OBC%H_u(I,j) + eta(i,j) = 2.0 * 0.5*((BT_OBC%eta_outer_u(I,j)+h_in) + & + (H_u/BT_OBC%Cg_u(I,j))*(BT_OBC%ubt_outer(I,j)-u_inlet)) - eta(i+1,j) + endif endif endif ; enddo ; enddo endif @@ -2416,24 +2424,26 @@ subroutine apply_eta_OBCs(OBC, eta, ubt, vbt, BT_OBC, G, MS, halo, dtbt) if ((OBC%apply_OBC_v_flather_north .or. OBC%apply_OBC_v_flather_south) .and. & associated(BT_OBC%OBC_mask_v)) then do J=js-1,je ; do i=is,ie ; if (BT_OBC%OBC_mask_v(i,J)) then - if (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) then - cfl = dtbt*BT_OBC%Cg_v(i,J)*G%IdyCv(i,J) ! CFL - v_inlet = cfl*vbt(i,J-1) + (1.0-cfl)*vbt(i,J) ! Valid for cfl <1 -! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i,j+1) ! external - h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1)) ! internal - - H_v = BT_OBC%H_v(i,J) - eta(i,j+1) = 2.0 * 0.5*((BT_OBC%eta_outer_v(i,J)+h_in) + & - (H_v/BT_OBC%Cg_v(i,J))*(v_inlet-BT_OBC%vbt_outer(i,J))) - eta(i,j) - elseif (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) then - cfl = dtbt*BT_OBC%Cg_v(i,J)*G%IdyCv(i,J) ! CFL - v_inlet = cfl*vbt(i,J+1) + (1.0-cfl)*vbt(i,J) ! Valid for cfl <1 -! h_in = 2.0*cfl*eta(i,j+1) + (1.0-2.0*cfl)*eta(i,j) ! external - h_in = eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2)) ! internal - - H_v = BT_OBC%H_v(i,J) - eta(i,j) = 2.0 * 0.5*((BT_OBC%eta_outer_v(i,J)+h_in) + & - (H_v/BT_OBC%Cg_v(i,J))*(BT_OBC%vbt_outer(i,J)-v_inlet)) - eta(i,j+1) + if (BT_OBC%OBC_kind_v(i,J) == OBC_FLATHER) then + if (BT_OBC%OBC_direction_v(i,J) == OBC_DIRECTION_N) then + cfl = dtbt*BT_OBC%Cg_v(i,J)*G%IdyCv(i,J) ! CFL + v_inlet = cfl*vbt(i,J-1) + (1.0-cfl)*vbt(i,J) ! Valid for cfl <1 +! h_in = 2.0*cfl*eta(i,j) + (1.0-2.0*cfl)*eta(i,j+1) ! external + h_in = eta(i,j) + (0.5-cfl)*(eta(i,j)-eta(i,j-1)) ! internal + + H_v = BT_OBC%H_v(i,J) + eta(i,j+1) = 2.0 * 0.5*((BT_OBC%eta_outer_v(i,J)+h_in) + & + (H_v/BT_OBC%Cg_v(i,J))*(v_inlet-BT_OBC%vbt_outer(i,J))) - eta(i,j) + elseif (BT_OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S) then + cfl = dtbt*BT_OBC%Cg_v(i,J)*G%IdyCv(i,J) ! CFL + v_inlet = cfl*vbt(i,J+1) + (1.0-cfl)*vbt(i,J) ! Valid for cfl <1 +! h_in = 2.0*cfl*eta(i,j+1) + (1.0-2.0*cfl)*eta(i,j) ! external + h_in = eta(i,j+1) + (0.5-cfl)*(eta(i,j+1)-eta(i,j+2)) ! internal + + H_v = BT_OBC%H_v(i,J) + eta(i,j) = 2.0 * 0.5*((BT_OBC%eta_outer_v(i,J)+h_in) + & + (H_v/BT_OBC%Cg_v(i,J))*(BT_OBC%vbt_outer(i,J)-v_inlet)) - eta(i,j+1) + endif endif endif ; enddo ; enddo endif @@ -2493,6 +2503,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, G, GV, MS, halo, use_BT_cont, Datu, D allocate(BT_OBC%eta_outer_u(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%eta_outer_u(:,:) = 0.0 allocate(BT_OBC%OBC_mask_u(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%OBC_mask_u(:,:)=.false. allocate(BT_OBC%OBC_kind_u(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%OBC_kind_u(:,:)=OBC_NONE + allocate(BT_OBC%OBC_direction_u(isdw-1:iedw,jsdw:jedw)); BT_OBC%OBC_direction_u(:,:)=OBC_NONE allocate(BT_OBC%Cg_v(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%Cg_v(:,:) = 0.0 allocate(BT_OBC%H_v(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%H_v(:,:) = 0.0 @@ -2501,11 +2512,13 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, G, GV, MS, halo, use_BT_cont, Datu, D allocate(BT_OBC%eta_outer_v(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%eta_outer_v(:,:)=0.0 allocate(BT_OBC%OBC_mask_v(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%OBC_mask_v(:,:)=.false. allocate(BT_OBC%OBC_kind_v(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%OBC_kind_v(:,:)=OBC_NONE + allocate(BT_OBC%OBC_direction_v(isdw-1:iedw,jsdw:jedw)); BT_OBC%OBC_direction_v(:,:)=OBC_NONE if (associated(OBC%OBC_mask_u)) then do j=js-1,je+1 ; do I=is-1,ie BT_OBC%OBC_mask_u(I,j) = OBC%OBC_mask_u(I,j) BT_OBC%OBC_kind_u(I,j) = OBC%OBC_kind_u(I,j) + BT_OBC%OBC_direction_u(I,j) = OBC%OBC_direction_u(I,j) enddo ; enddo if (OBC%apply_OBC_u) then do k=1,nz ; do j=js,je ; do I=is-1,ie @@ -2541,6 +2554,7 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, G, GV, MS, halo, use_BT_cont, Datu, D do J=js-1,je ; do i=is-1,ie+1 BT_OBC%OBC_mask_v(i,J) = OBC%OBC_mask_v(i,J) BT_OBC%OBC_kind_v(i,J) = OBC%OBC_kind_v(i,J) + BT_OBC%OBC_direction_v(i,J) = OBC%OBC_direction_v(i,J) enddo ; enddo if (OBC%apply_OBC_v) then do k=1,nz ; do J=js-1,je ; do i=is,ie @@ -2590,6 +2604,7 @@ subroutine destroy_BT_OBC(BT_OBC) if (associated(BT_OBC%OBC_mask_u)) deallocate(BT_OBC%OBC_mask_u) if (associated(BT_OBC%OBC_kind_u)) deallocate(BT_OBC%OBC_kind_u) + if (associated(BT_OBC%OBC_direction_u)) deallocate(BT_OBC%OBC_direction_u) deallocate(BT_OBC%Cg_u) deallocate(BT_OBC%H_u) deallocate(BT_OBC%uhbt) @@ -2598,6 +2613,7 @@ subroutine destroy_BT_OBC(BT_OBC) if (associated(BT_OBC%OBC_mask_v)) deallocate(BT_OBC%OBC_mask_v) if (associated(BT_OBC%OBC_kind_v)) deallocate(BT_OBC%OBC_kind_v) + if (associated(BT_OBC%OBC_direction_v)) deallocate(BT_OBC%OBC_direction_v) deallocate(BT_OBC%Cg_v) deallocate(BT_OBC%H_v) deallocate(BT_OBC%vhbt) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index c036da9935..2e740f09ad 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -31,8 +31,11 @@ module MOM_open_boundary public set_Flather_data integer, parameter, public :: OBC_NONE = 0, OBC_SIMPLE = 1, OBC_WALL = 2 -integer, parameter, public :: OBC_FLATHER_E = 4, OBC_FLATHER_W = 5 -integer, parameter, public :: OBC_FLATHER_N = 6, OBC_FLATHER_S = 7 +integer, parameter, public :: OBC_FLATHER = 3 +integer, parameter, public :: OBC_DIRECTION_N = 100 !< Indicates the boundary is an effective northern boundary +integer, parameter, public :: OBC_DIRECTION_S = 200 !< Indicates the boundary is an effective southern boundary +integer, parameter, public :: OBC_DIRECTION_E = 300 !< Indicates the boundary is an effective eastern boundary +integer, parameter, public :: OBC_DIRECTION_W = 400 !< Indicates the boundary is an effective western boundary !> Open-boundary data type, public :: ocean_OBC_type @@ -50,13 +53,18 @@ module MOM_open_boundary OBC_mask_u => NULL(), & !< True at zonal velocity points that have prescribed OBCs. OBC_mask_v => NULL() !< True at meridional velocity points that have prescribed OBCs. ! These arrays indicate the kind of open boundary conditions that are to be applied at the u and v - ! points, and can be OBC_NONE, OBC_SIMPLE, OBC_WALL, or one of OBC_FLATHER_[EWNS]. Generally these + ! points, and can be OBC_NONE, OBC_SIMPLE, OBC_WALL, or OBC_FLATHER. Generally these ! should be consistent with OBC_mask_[uv], with OBC_mask_[uv] .false. for OBC_kind_[uv] = NONE ! and true for all other values. integer, pointer, dimension(:,:) :: & OBC_kind_u => NULL(), & !< Type of OBC at u-points. OBC_kind_v => NULL() !< Type of OBC at v-points. - ! The following apply at points with OBC_kind_[uv] = OBC_FLATHER_x. + ! These arrays indicate the outward-pointing orientation of the open boundary and will be set to + ! one of OBC_DIRECTION_N, OBC_DIRECTION_S, OBC_DIRECTION_E or OBC_DIRECTION_W. + integer, pointer, dimension(:,:) :: & + OBC_direction_u => NULL(), & !< Orientation of OBC at u-points. + OBC_direction_v => NULL() !< Orientation of OBC at v-points. + ! The following apply at points with OBC_kind_[uv] = OBC_FLATHER. real, pointer, dimension(:,:,:) :: & rx_old_u => NULL(), & !< The rx_old_u value for radiation coeff for u-velocity in x-direction ry_old_v => NULL(), & !< The ry_old_v value for radiation coeff for v-velocity in y-direction @@ -220,17 +228,17 @@ subroutine open_boundary_impose_normal_slope(OBC, G, depth) if (.not.associated(OBC)) return - if (associated(OBC%OBC_kind_u)) then + if (associated(OBC%OBC_direction_u)) then do j=G%jsd,G%jed ; do I=G%isd,G%ied-1 - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) depth(i+1,j) = depth(i,j) - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) depth(i,j) = depth(i+1,j) + if (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_E) depth(i+1,j) = depth(i,j) + if (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_W) depth(i,j) = depth(i+1,j) enddo ; enddo endif if (associated(OBC%OBC_kind_v)) then do J=G%jsd,G%jed-1 ; do i=G%isd,G%ied - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) depth(i,j+1) = depth(i,j) - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) depth(i,j) = depth(i,j+1) + if (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_N) depth(i,j+1) = depth(i,j) + if (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S) depth(i,j) = depth(i,j+1) enddo ; enddo endif @@ -294,7 +302,7 @@ subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & if (OBC%apply_OBC_u_flather_east .or. OBC%apply_OBC_u_flather_west) then do k=1,nz ; do j=js,je ; do I=is-1,ie ; if (OBC%OBC_mask_u(I,j)) then - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) then + if (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_E) then dhdt = u_old(I-1,j,k)-u_new(I-1,j,k) !old-new dhdx = u_new(I-1,j,k)-u_new(I-2,j,k) !in new time backward sasha for I-1 rx_new = 0.0 @@ -311,7 +319,7 @@ subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & ! OBC%rx_old_h(I,j,k) = rx_avg ! h_new(I+1,j,k) = (h_old(I+1,j,k) + rx_avg*h_new(I,j,k)) / (1.0+rx_avg) !original endif - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) then + if (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_W) then dhdt = u_old(I+1,j,k)-u_new(I+1,j,k) !old-new dhdx = u_new(I+1,j,k)-u_new(I+2,j,k) !in new time backward sasha for I+1 rx_new = 0.0 @@ -333,7 +341,7 @@ subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & if (OBC%apply_OBC_v_flather_north .or. OBC%apply_OBC_v_flather_south) then do k=1,nz ; do J=js-1,je ; do i=is,ie ; if (OBC%OBC_mask_v(i,J)) then - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) then + if (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_N) then dhdt = v_old(i,J-1,k)-v_new(i,J-1,k) !old-new dhdx = v_new(i,J-1,k)-v_new(i,J-2,k) !in new time backward sasha for J-1 rx_new = 0.0 @@ -351,7 +359,7 @@ subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & ! h_new(i,J+1,k) = (h_old(i,J+1,k) + rx_avg*h_new(i,J,k)) / (1.0+rx_avg) !original endif - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) then + if (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S) then dhdt = v_old(i,J+1,k)-v_new(i,J+1,k) !old-new dhdx = v_new(i,J+1,k)-v_new(i,J+2,k) !in new time backward sasha for J+1 rx_new = 0.0 @@ -391,12 +399,18 @@ subroutine set_Flather_positions(G, OBC) if (.not.associated(OBC%OBC_mask_u)) then allocate(OBC%OBC_mask_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; OBC%OBC_mask_u(:,:) = .false. endif + if (.not.associated(OBC%OBC_direction_u)) then + allocate(OBC%OBC_direction_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; OBC%OBC_direction_u(:,:) = OBC_NONE + endif if (.not.associated(OBC%OBC_kind_u)) then allocate(OBC%OBC_kind_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; OBC%OBC_kind_u(:,:) = OBC_NONE endif if (.not.associated(OBC%OBC_mask_v)) then allocate(OBC%OBC_mask_v(G%isd:G%ied,G%JsdB:G%JedB)) ; OBC%OBC_mask_v(:,:) = .false. endif + if (.not.associated(OBC%OBC_direction_v)) then + allocate(OBC%OBC_direction_v(G%isd:G%ied,G%JsdB:G%JedB)) ; OBC%OBC_direction_v(:,:) = OBC_NONE + endif if (.not.associated(OBC%OBC_kind_v)) then allocate(OBC%OBC_kind_v(G%isd:G%ied,G%JsdB:G%JedB)) ; OBC%OBC_kind_v(:,:) = OBC_NONE endif @@ -421,11 +435,18 @@ subroutine set_Flather_positions(G, OBC) do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB if ((I+G%idg_offset) == east_boundary) then !eastern side OBC%OBC_mask_u(I,j) = .true. - OBC%OBC_kind_u(I,j) = OBC_FLATHER_E + OBC%OBC_direction_u(I,j) = OBC_DIRECTION_E + OBC%OBC_kind_u(I,j) = OBC_FLATHER OBC%OBC_mask_v(i+1,J) = .true. - if (OBC%OBC_kind_v(i+1,J) == OBC_NONE) OBC%OBC_kind_v(i+1,J) = OBC_FLATHER_E + if (OBC%OBC_direction_v(i+1,J) == OBC_NONE) then + OBC%OBC_direction_v(i+1,J) = OBC_DIRECTION_E + OBC%OBC_kind_v(i+1,J) = OBC_FLATHER + endif OBC%OBC_mask_v(i+1,J-1) = .true. - if (OBC%OBC_kind_v(i+1,J-1) == OBC_NONE) OBC%OBC_kind_v(i+1,J-1) = OBC_FLATHER_E + if (OBC%OBC_direction_v(i+1,J-1) == OBC_NONE) then + OBC%OBC_direction_v(i+1,J-1) = OBC_DIRECTION_E + OBC%OBC_kind_v(i+1,J-1) = OBC_FLATHER + endif endif enddo ; enddo endif @@ -435,11 +456,18 @@ subroutine set_Flather_positions(G, OBC) do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB if ((I+G%idg_offset) == west_boundary) then !western side OBC%OBC_mask_u(I,j) = .true. - OBC%OBC_kind_u(I,j) = OBC_FLATHER_W + OBC%OBC_direction_u(I,j) = OBC_DIRECTION_W + OBC%OBC_kind_u(I,j) = OBC_FLATHER OBC%OBC_mask_v(i,J) = .true. - if (OBC%OBC_kind_v(i,J) == OBC_NONE) OBC%OBC_kind_v(i,J) = OBC_FLATHER_W + if (OBC%OBC_direction_v(i,J) == OBC_NONE) then + OBC%OBC_direction_v(i,J) = OBC_DIRECTION_W + OBC%OBC_kind_v(i,J) = OBC_FLATHER + endif OBC%OBC_mask_v(i,J-1) = .true. - if (OBC%OBC_kind_v(i,J-1) == OBC_NONE) OBC%OBC_kind_v(i,J-1) = OBC_FLATHER_W + if (OBC%OBC_direction_v(i,J-1) == OBC_NONE) then + OBC%OBC_direction_v(i,J-1) = OBC_DIRECTION_W + OBC%OBC_kind_v(i,J-1) = OBC_FLATHER + endif endif enddo ; enddo endif @@ -449,11 +477,18 @@ subroutine set_Flather_positions(G, OBC) do J=G%JsdB,G%JedB ; do i=G%isd,G%ied if ((J+G%jdg_offset) == north_boundary) then !northern side OBC%OBC_mask_v(i,J) = .true. - OBC%OBC_kind_v(i,J) = OBC_FLATHER_N + OBC%OBC_direction_v(i,J) = OBC_DIRECTION_N + OBC%OBC_kind_v(i,J) = OBC_FLATHER OBC%OBC_mask_u(I,j+1) = .true. - if (OBC%OBC_kind_u(I,j+1) == OBC_NONE) OBC%OBC_kind_u(I,j+1) = OBC_FLATHER_N + if (OBC%OBC_direction_u(I,j+1) == OBC_NONE) then + OBC%OBC_direction_u(I,j+1) = OBC_DIRECTION_N + OBC%OBC_kind_u(I,j+1) = OBC_FLATHER + endif OBC%OBC_mask_u(I-1,j+1) = .true. - if (OBC%OBC_kind_u(I-1,j+1) == OBC_NONE) OBC%OBC_kind_u(I-1,j+1) = OBC_FLATHER_N + if (OBC%OBC_direction_u(I-1,j+1) == OBC_NONE) then + OBC%OBC_direction_u(I-1,j+1) = OBC_DIRECTION_N + OBC%OBC_kind_u(I-1,j+1) = OBC_FLATHER + endif endif enddo ; enddo endif @@ -463,11 +498,18 @@ subroutine set_Flather_positions(G, OBC) do J=G%JsdB,G%JedB ; do i=G%isd,G%ied if ((J+G%jdg_offset) == south_boundary) then !southern side OBC%OBC_mask_v(i,J) = .true. - OBC%OBC_kind_v(i,J) = OBC_FLATHER_S + OBC%OBC_direction_v(i,J) = OBC_DIRECTION_S + OBC%OBC_kind_v(i,J) = OBC_FLATHER OBC%OBC_mask_u(I,j) = .true. - if (OBC%OBC_kind_u(I,j) == OBC_NONE) OBC%OBC_kind_u(I,j) = OBC_FLATHER_S + if (OBC%OBC_direction_u(I,j) == OBC_NONE) then + OBC%OBC_direction_u(I,j) = OBC_DIRECTION_S + OBC%OBC_kind_u(I,j) = OBC_FLATHER + endif OBC%OBC_mask_u(I-1,j) = .true. - if (OBC%OBC_kind_u(I-1,j) == OBC_NONE) OBC%OBC_kind_u(I-1,j) = OBC_FLATHER_S + if (OBC%OBC_direction_u(I-1,j) == OBC_NONE) then + OBC%OBC_direction_u(I-1,j) = OBC_DIRECTION_S + OBC%OBC_kind_u(I-1,j) = OBC_FLATHER + endif endif enddo ; enddo endif @@ -598,10 +640,10 @@ subroutine set_Flather_data(OBC, tv, h, G, PF, tracer_Reg) call pass_var(tv%S, G%Domain) do k=1,nz ; do j=js,je ; do I=is-1,ie if (OBC%OBC_mask_u(I,j)) then - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) then + if (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_E) then OBC_T_u(I,j,k) = tv%T(i,j,k) OBC_S_u(I,j,k) = tv%S(i,j,k) - elseif (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) then + elseif (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_W) then OBC_T_u(I,j,k) = tv%T(i+1,j,k) OBC_S_u(I,j,k) = tv%S(i+1,j,k) elseif (G%mask2dT(i,j) + G%mask2dT(i+1,j) > 0) then @@ -621,10 +663,10 @@ subroutine set_Flather_data(OBC, tv, h, G, PF, tracer_Reg) do k=1,nz ; do J=js-1,je ; do i=is,ie if (OBC%OBC_mask_v(i,J)) then - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) then + if (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_N) then OBC_T_v(i,J,k) = tv%T(i,j,k) OBC_S_v(i,J,k) = tv%S(i,j,k) - elseif (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) then + elseif (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S) then OBC_T_v(i,J,k) = tv%T(i,j+1,k) OBC_S_v(i,J,k) = tv%S(i,j+1,k) elseif (G%mask2dT(i,j) + G%mask2dT(i,j+1) > 0) then @@ -651,28 +693,28 @@ subroutine set_Flather_data(OBC, tv, h, G, PF, tracer_Reg) call add_tracer_OBC_values("S", tracer_Reg, OBC_in_u=OBC_S_u, & OBC_in_v=OBC_S_v) do k=1,nz ; do j=jsd,jed ; do I=isd,ied-1 - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) then + if (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_E) then tv%T(i+1,j,k) = tv%T(i,j,k) ; tv%S(i+1,j,k) = tv%S(i,j,k) - elseif (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) then + elseif (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_W) then tv%T(i,j,k) = tv%T(i+1,j,k) ; tv%S(i,j,k) = tv%S(i+1,j,k) endif enddo ; enddo ; enddo do k=1,nz ; do J=jsd,jed-1 ; do i=isd,ied - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) then + if (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_N) then tv%T(i,j+1,k) = tv%T(i,j,k) ; tv%S(i,j+1,k) = tv%S(i,j,k) - elseif (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) then + elseif (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S) then tv%T(i,j,k) = tv%T(i,j+1,k) ; tv%S(i,j,k) = tv%S(i,j+1,k) endif enddo ; enddo ; enddo endif do k=1,nz ; do j=jsd,jed ; do I=isd,ied-1 - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) h(i+1,j,k) = h(i,j,k) - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W) h(i,j,k) = h(i+1,j,k) + if (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_E) h(i+1,j,k) = h(i,j,k) + if (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_W) h(i,j,k) = h(i+1,j,k) enddo ; enddo ; enddo do k=1,nz ; do J=jsd,jed-1 ; do i=isd,ied - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) h(i,j+1,k) = h(i,j,k) - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S) h(i,j,k) = h(i,j+1,k) + if (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_N) h(i,j+1,k) = h(i,j,k) + if (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S) h(i,j,k) = h(i,j+1,k) enddo ; enddo ; enddo end subroutine set_Flather_data diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 191eb62005..897810c527 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -93,8 +93,7 @@ module MOM_hor_visc use MOM_grid, only : ocean_grid_type use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type -use MOM_open_boundary, only : ocean_OBC_type, OBC_FLATHER_E, OBC_FLATHER_W -use MOM_open_boundary, only : OBC_FLATHER_N, OBC_FLATHER_S +use MOM_open_boundary, only : ocean_OBC_type, OBC_FLATHER use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -587,8 +586,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, G%IareaCu(I,j)) / (0.5*(h(i+1,j,k) + h(i,j,k)) + h_neglect) if (apply_OBC) then ; if (OBC%OBC_mask_u(I,j)) then - if ((OBC%OBC_kind_u(I,j) == OBC_FLATHER_E) .or. & - (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W)) diffu(I,j,k) = 0.0 + if ((OBC%OBC_kind_u(I,j) == OBC_FLATHER)) diffu(I,j,k) = 0.0 endif ; endif enddo ; enddo @@ -600,8 +598,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, CS%DX2h(i,j+1)*str_xx(i,j+1))) * & G%IareaCv(i,J)) / (0.5*(h(i,j+1,k) + h(i,j,k)) + h_neglect) if (apply_OBC) then ; if (OBC%OBC_mask_v(i,J)) then - if ((OBC%OBC_kind_v(i,J) == OBC_FLATHER_N) .or. & - (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S)) diffv(I,j,k) = 0.0 + if ((OBC%OBC_kind_v(i,J) == OBC_FLATHER)) diffv(I,j,k) = 0.0 endif ; endif enddo ; enddo diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 949039f7e5..674a5f1e41 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -14,8 +14,8 @@ module MOM_tracer_advect use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe 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_FLATHER_E -use MOM_open_boundary, only : OBC_FLATHER_W, OBC_FLATHER_N, OBC_FLATHER_S +use MOM_open_boundary, only : ocean_OBC_type, OBC_DIRECTION_E +use MOM_open_boundary, only : OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_tracer_registry, only : tracer_registry_type, tracer_type, MOM_tracer_chksum use MOM_verticalGrid, only : verticalGrid_type @@ -478,9 +478,9 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & ! Tracer fluxes are set to prescribed values only for inflows ! from masked areas. if (((uhr(I,j,k) > 0.0) .and. ((G%mask2dT(i,j) < 0.5) .or. & - (OBC%OBC_kind_u(I,j) == OBC_FLATHER_W))) .or. & + (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_W))) .or. & ((uhr(I,j,k) < 0.0) .and. ((G%mask2dT(i+1,j) < 0.5) .or. & - (OBC%OBC_kind_u(I,j) == OBC_FLATHER_E))) ) then + (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_E))) ) then do_i(I) = .true. ; do_any_i = .true. uhh(I) = uhr(I,j,k) endif @@ -738,9 +738,9 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & ! Tracer fluxes are set to prescribed values only for inflows ! from masked areas. if (((vhr(i,J,k) > 0.0) .and. ((G%mask2dT(i,j) < 0.5) .or. & - (OBC%OBC_kind_v(i,J) == OBC_FLATHER_S))) .or. & + (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S))) .or. & ((vhr(i,J,k) < 0.0) .and. ((G%mask2dT(i,j+1) < 0.5) .or. & - (OBC%OBC_kind_v(i,J) == OBC_FLATHER_N))) ) then + (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_N))) ) then do_i(i) = .true. ; do_any_i = .true. vhh(i,J) = vhr(i,J,k) endif diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 73b581d299..ab45688a66 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -21,8 +21,6 @@ module MOM_tracer_hor_diff use MOM_neutral_diffusion, only : neutral_diffusion_init, neutral_diffusion_end use MOM_neutral_diffusion, only : neutral_diffusion_CS use MOM_neutral_diffusion, only : neutral_diffusion_calc_coeffs, neutral_diffusion -use MOM_open_boundary, only : ocean_OBC_type, OBC_FLATHER_E -use MOM_open_boundary, only : OBC_FLATHER_W, OBC_FLATHER_N, OBC_FLATHER_S use MOM_tracer_registry, only : tracer_registry_type, tracer_type, MOM_tracer_chksum use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index d0337bcc9d..6c1723be71 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -327,6 +327,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) allocate(OBC%u(IsdB:IedB,jsd:jed,nz)) ; OBC%u(:,:,:) = 0.0 allocate(OBC%uh(IsdB:IedB,jsd:jed,nz)) ; OBC%uh(:,:,:) = 0.0 allocate(OBC%OBC_kind_u(IsdB:IedB,jsd:jed)) ; OBC%OBC_kind_u(:,:) = OBC_NONE + allocate(OBC%OBC_direction_u(IsdB:IedB,jsd:jed)) ; OBC%OBC_direction_u(:,:) = OBC_NONE do j=jsd,jed ; do I=IsdB,IedB if (OBC%OBC_mask_u(I,j)) OBC%OBC_kind_u(I,j) = OBC_SIMPLE enddo ; enddo @@ -335,6 +336,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) allocate(OBC%v(isd:ied,JsdB:JedB,nz)) ; OBC%v(:,:,:) = 0.0 allocate(OBC%vh(isd:ied,JsdB:JedB,nz)) ; OBC%vh(:,:,:) = 0.0 allocate(OBC%OBC_kind_v(isd:ied,JsdB:JedB)) ; OBC%OBC_kind_v(:,:) = OBC_NONE + allocate(OBC%OBC_direction_v(isd:ied,JsdB:JedB)) ; OBC%OBC_direction_v(:,:) = OBC_NONE do J=JsdB,JedB ; do i=isd,ied if (OBC%OBC_mask_v(i,J)) OBC%OBC_kind_v(i,J) = OBC_SIMPLE enddo ; enddo diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 33e1090617..1481c8845c 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -26,8 +26,8 @@ module user_initialization use MOM_io, only : close_file, fieldtype, file_exists use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE use MOM_io, only : write_field, slasher -use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE -use MOM_open_boundary, only : OBC_FLATHER_E, OBC_FLATHER_W, OBC_FLATHER_N, OBC_FLATHER_S +use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE, OBC_FLATHER +use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_sponge, only : set_up_sponge_field, initialize_sponge, sponge_CS use MOM_tracer_registry, only : tracer_registry_type, add_tracer_OBC_values use MOM_variables, only : thermo_var_ptrs From f182829751671d4b3326e88a94c12aea83d64d72 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Sun, 19 Jun 2016 11:50:28 -0400 Subject: [PATCH 21/33] Unified deallocation of OBC on PE without OBs - Modified open_boundary_impose_land_mask() to deallocate if the PE has no open boundaries. - Provided an open_boundary_dealloc (called from open_boundary_end) - Moved the deallocation out of DOME_initialization.F90. - No answer changes. --- src/core/MOM_open_boundary.F90 | 64 +++++++++++++++++-- .../MOM_fixed_initialization.F90 | 3 +- src/user/DOME_initialization.F90 | 8 --- 3 files changed, 60 insertions(+), 15 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 2e740f09ad..5b58b10009 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -157,7 +157,7 @@ subroutine open_boundary_config(G, param_file, OBC) OBC%apply_OBC_v_flather_north .or. OBC%apply_OBC_v_flather_south .or. & OBC%apply_OBC_u_flather_east .or. OBC%apply_OBC_u_flather_west)) then ! No open boundaries have been requested - deallocate(OBC) + call open_boundary_dealloc(OBC) endif end subroutine open_boundary_config @@ -213,16 +213,39 @@ logical function open_boundary_query(OBC, apply_orig_OBCs, apply_orig_Flather) end function open_boundary_query !> Deallocate open boundary data -subroutine open_boundary_end(OBC) +subroutine open_boundary_dealloc(OBC) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + if (.not. associated(OBC)) return + if (associated(OBC%OBC_mask_u)) deallocate(OBC%OBC_mask_u) + if (associated(OBC%OBC_mask_v)) deallocate(OBC%OBC_mask_v) + if (associated(OBC%OBC_kind_u)) deallocate(OBC%OBC_kind_u) + if (associated(OBC%OBC_kind_v)) deallocate(OBC%OBC_kind_v) + if (associated(OBC%rx_old_u)) deallocate(OBC%rx_old_u) + if (associated(OBC%ry_old_v)) deallocate(OBC%ry_old_v) + if (associated(OBC%rx_old_h)) deallocate(OBC%rx_old_h) + if (associated(OBC%ry_old_h)) deallocate(OBC%ry_old_h) + if (associated(OBC%ubt_outer)) deallocate(OBC%ubt_outer) + if (associated(OBC%vbt_outer)) deallocate(OBC%vbt_outer) + if (associated(OBC%eta_outer_u)) deallocate(OBC%eta_outer_u) + if (associated(OBC%eta_outer_v)) deallocate(OBC%eta_outer_v) + if (associated(OBC%u)) deallocate(OBC%u) + if (associated(OBC%v)) deallocate(OBC%v) + if (associated(OBC%uh)) deallocate(OBC%uh) + if (associated(OBC%vh)) deallocate(OBC%vh) deallocate(OBC) +end subroutine open_boundary_dealloc + +!> Close open boundary data +subroutine open_boundary_end(OBC) + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + call open_boundary_dealloc(OBC) end subroutine open_boundary_end !> Sets the slope of bathymetry normal to an open bounndary to zero. subroutine open_boundary_impose_normal_slope(OBC, G, depth) - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: depth !< Bathymetry at h-points + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: depth !< Bathymetry at h-points ! Local variables integer :: i, j @@ -244,12 +267,13 @@ subroutine open_boundary_impose_normal_slope(OBC, G, depth) end subroutine open_boundary_impose_normal_slope -!> Sets the slope of bathymetry normal to an open bounndary to zero. +!> Reconcile masks and open boundaries, deallocate OBC on PEs where it is not needed subroutine open_boundary_impose_land_mask(OBC, G) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure ! Local variables integer :: i, j + logical :: any_U, any_V if (.not.associated(OBC)) return @@ -257,6 +281,7 @@ subroutine open_boundary_impose_land_mask(OBC, G) do j=G%jsd,G%jed ; do I=G%isd,G%ied-1 if (G%mask2dCu(I,j) == 0) then OBC%OBC_kind_u(I,j) = OBC_NONE + OBC%OBC_direction_u(I,j) = OBC_NONE OBC%OBC_mask_u(I,j) = .false. endif enddo ; enddo @@ -266,11 +291,38 @@ subroutine open_boundary_impose_land_mask(OBC, G) do J=G%jsd,G%jed-1 ; do i=G%isd,G%ied if (G%mask2dCv(i,J) == 0) then OBC%OBC_kind_v(i,J) = OBC_NONE + OBC%OBC_direction_v(i,J) = OBC_NONE OBC%OBC_mask_v(i,J) = .false. endif enddo ; enddo endif + any_U = .false. + if (associated(OBC%OBC_mask_u)) then + do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + ! G%mask2du will be open wherever bathymetry allows it. + ! Bathymetry outside of the open boundary was adjusted to match + ! the bathymetry inside so these points will be open unless the + ! bathymetry inside the boundary was do shallow and flagged as land. + if (OBC%OBC_mask_u(I,j)) any_U = .true. + enddo ; enddo + if (.not. any_U) then + deallocate(OBC%OBC_mask_u) + endif + endif + + any_V = .false. + if (associated(OBC%OBC_mask_v)) then + do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + if (OBC%OBC_mask_v(i,J)) any_V = .true. + enddo ; enddo + if (.not. any_V) then + deallocate(OBC%OBC_mask_v) + endif + endif + + if (.not.(any_U .or. any_V)) call open_boundary_dealloc(OBC) + end subroutine open_boundary_impose_land_mask !> Diagnose radiation conditions at open boundaries diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index b6f10bfaec..ec8f85d278 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -114,8 +114,9 @@ subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir) ! This call sets masks that prohibit flow over any point interpreted as land call initialize_masks(G, PF) - ! Make OBC mask consistent with land mask + ! Make OBC mask consistent with land mask, deallocate OBC on PEs where it is not needed call open_boundary_impose_land_mask(OBC, G) + if (debug) then call hchksum(G%bathyT, 'MOM_initialize_fixed: depth ', G%HI, haloshift=1) call hchksum(G%mask2dT, 'MOM_initialize_fixed: mask2dT ', G%HI) diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 6c1723be71..44d0ec94d0 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -240,12 +240,10 @@ subroutine DOME_set_OBC_positions(G, param_file, OBC) ! Local variables character(len=40) :: mod = "DOME_set_OBC_positions" ! This subroutine's name. integer :: i, j - logical :: any_OBC ! Set to true if any points in this subdomain use OBCs if (.not.associated(OBC)) call MOM_error(FATAL, & "DOME_initialization, DOME_set_OBC_positions: OBC type was not allocated!") - any_OBC = .false. if (OBC%apply_OBC_u) then ! Set where u points are determined by OBCs. !allocate(OBC_mask_u(IsdB:IedB,jsd:jed)) ; OBC_mask_u(:,:) = .false. @@ -259,15 +257,9 @@ subroutine DOME_set_OBC_positions(G, param_file, OBC) if ((G%geoLonCv(i,J) > 1000.0) .and. (G%geoLonCv(i,J) < 1100.0) .and. & (abs(G%geoLatCv(i,J) - G%gridLatB(G%JegB)) < 0.1)) then OBC%OBC_mask_v(i,J) = .true. - any_OBC = .true. endif enddo ; enddo endif - if (.not.any_OBC) then - ! If this PE does not have any OBC points then we do not need the mask - OBC%apply_OBC_v = .false. - deallocate(OBC%OBC_mask_v) - endif end subroutine DOME_set_OBC_positions !> This subroutine sets the properties of flow at open boundary conditions. From 5f222f07874fe3b97744e09b6333f7a07764b157 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Mon, 20 Jun 2016 16:15:17 -0800 Subject: [PATCH 22/33] Added OBC for flow parallel to boundary. --- src/core/MOM_continuity.F90 | 4 ++-- src/core/MOM_continuity_PPM.F90 | 32 ++++++++++++++++++++++++-- src/core/MOM_dynamics_legacy_split.F90 | 4 ++-- 3 files changed, 34 insertions(+), 6 deletions(-) diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 555484057d..cefb7ee938 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -79,8 +79,8 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) type(ocean_grid_type), intent(inout) :: G type(verticalGrid_type), intent(in) :: GV - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hin real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uh diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 2562ca995f..84f24e4ced 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -110,8 +110,8 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) type(ocean_grid_type), intent(inout) :: G type(continuity_PPM_CS), pointer :: CS - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hin real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uh @@ -236,6 +236,14 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_W)) & h(i,j,k) = h_input(i+1,j,k) enddo + enddo + do J=LB%jsh-1,LB%jeh + do i=LB%ish-1,LB%ieh+1 + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_E)) & + v(i,J,k) = v(i-1,J,k) + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_W)) & + v(i,J,k) = v(i+1,J,k) + enddo enddo ; enddo endif LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec @@ -264,6 +272,12 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S)) & h(i,j,k) = h_input(i,j+1,k) enddo ; enddo + do j=LB%jsh-1,LB%jeh+1 ; do I=LB%ish-1,LB%ieh + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_N)) & + u(I,j,k) = u(I,j-1,k) + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_S)) & + u(I,j,k) = u(I,j+1,k) + enddo ; enddo enddo endif else ! .not. x_first @@ -291,6 +305,12 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S)) & h(i,j,k) = h_input(i,j+1,k) enddo ; enddo + do j=LB%jsh-1,LB%jeh+1 ; do I=LB%ish-1,LB%ieh + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_N)) & + u(I,j,k) = u(I,j-1,k) + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_S)) & + u(I,j,k) = u(I,j+1,k) + enddo ; enddo enddo endif @@ -319,6 +339,14 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_W)) & h(i,j,k) = h_input(i+1,j,k) enddo + enddo + do J=LB%jsh-1,LB%jeh + do i=LB%ish-1,LB%ieh+1 + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_E)) & + v(i,J,k) = v(i-1,J,k) + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_W)) & + v(i,J,k) = v(i+1,J,k) + enddo enddo ; enddo endif endif diff --git a/src/core/MOM_dynamics_legacy_split.F90 b/src/core/MOM_dynamics_legacy_split.F90 index 77b9f3c6f5..0f30cf7bfc 100644 --- a/src/core/MOM_dynamics_legacy_split.F90 +++ b/src/core/MOM_dynamics_legacy_split.F90 @@ -1052,8 +1052,8 @@ end subroutine step_MOM_dyn_legacy_split subroutine adjustments_dyn_legacy_split(u, v, h, dt, G, GV, CS) type(ocean_grid_type), intent(inout) :: G type(verticalGrid_type), intent(in) :: GV - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h real, intent(in) :: dt type(MOM_dyn_legacy_split_CS), pointer :: CS From 9862707d084ffa18b9a4a4491e11bcb0ba87dd49 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Tue, 28 Jun 2016 09:50:26 -0800 Subject: [PATCH 23/33] Update to ISOMIP_tracer for OBC --- src/tracer/ISOMIP_tracer.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 072f5b4d87..44d985ae05 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -30,7 +30,8 @@ module ISOMIP_tracer use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_registry, only : add_tracer_diagnostics, add_tracer_OBC_values use MOM_tracer_registry, only : tracer_vertdiff -use MOM_variables, only : surface, ocean_OBC_type +use MOM_variables, only : surface +use MOM_open_boundary, only : ocean_OBC_type use MOM_verticalGrid, only : verticalGrid_type use coupler_util, only : set_coupler_values, ind_csurf From ffb4aea514d8d5e87593a980681bb0796fb6ead3 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Tue, 28 Jun 2016 11:13:09 -0800 Subject: [PATCH 24/33] Fix OBC after merge. --- src/core/MOM_open_boundary.F90 | 15 ++++++++------- src/user/DOME_initialization.F90 | 2 +- src/user/user_initialization.F90 | 2 +- 3 files changed, 10 insertions(+), 9 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 5b58b10009..d2cb92ac43 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -11,6 +11,7 @@ module MOM_open_boundary use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type, log_param use MOM_grid, only : ocean_grid_type +use MOM_dyn_horgrid, only : dyn_horgrid_type use MOM_io, only : EAST_FACE, NORTH_FACE use MOM_io, only : slasher, read_data use MOM_tracer_registry, only : add_tracer_OBC_values, tracer_registry_type @@ -112,7 +113,7 @@ module MOM_open_boundary !> Enables OBC module and reads configuration parameters subroutine open_boundary_config(G, param_file, OBC) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure type(param_file_type), intent(in) :: param_file !< Parameter file handle type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure ! Local variables @@ -164,9 +165,9 @@ end subroutine open_boundary_config !> Initialize open boundary control structure subroutine open_boundary_init(G, param_file, OBC) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(param_file_type), intent(in) :: param_file !< Parameter file handle - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(param_file_type), intent(in) :: param_file !< Parameter file handle + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure ! Local variables if (.not.associated(OBC)) return @@ -244,7 +245,7 @@ end subroutine open_boundary_end !> Sets the slope of bathymetry normal to an open bounndary to zero. subroutine open_boundary_impose_normal_slope(OBC, G, depth) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: depth !< Bathymetry at h-points ! Local variables integer :: i, j @@ -270,7 +271,7 @@ end subroutine open_boundary_impose_normal_slope !> Reconcile masks and open boundaries, deallocate OBC on PEs where it is not needed subroutine open_boundary_impose_land_mask(OBC, G) type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure ! Local variables integer :: i, j logical :: any_U, any_V @@ -442,7 +443,7 @@ end subroutine Radiation_Open_Bdry_Conds !> Sets the domain boundaries as Flather open boundaries using the original !! Flather run-time logicals subroutine set_Flather_positions(G, OBC) - type(ocean_grid_type), intent(inout) :: G + type(dyn_horgrid_type), intent(inout) :: G type(ocean_OBC_type), pointer :: OBC ! Local variables integer :: east_boundary, west_boundary, north_boundary, south_boundary diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 85659535e0..334fbd8208 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -235,7 +235,7 @@ end subroutine DOME_initialize_sponges !> Set the positions of the open boundary needed for the DOME experiment. subroutine DOME_set_OBC_positions(G, param_file, OBC) - type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(dyn_horgrid_type), intent(in) :: G !< Grid structure. type(param_file_type), intent(in) :: param_file !< Parameter file handle. type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure. ! Local variables diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index 4bc21f9162..c0868ef543 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -201,7 +201,7 @@ end subroutine USER_initialize_sponges !> This subroutine sets the location of open boundaries. subroutine USER_set_OBC_positions(G, param_file, OBC) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(dyn_horgrid_type), intent(in) :: G !< The ocean's grid structure. type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. From bd59a04535cca00172f939481497f4402e22108e Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Tue, 28 Jun 2016 15:02:50 -0800 Subject: [PATCH 25/33] Don't deallocate OBC on pes without boundary --- src/core/MOM_open_boundary.F90 | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index d2cb92ac43..c1b5e6e011 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -101,6 +101,7 @@ module MOM_open_boundary real :: rx_max !< The maximum magnitude of the baroclinic radiation !! velocity (or speed of characteristics), in m s-1. The !! default value is 10 m s-1. + logical :: this_pe !< Is there an open boundary on this tile? end type ocean_OBC_type integer :: id_clock_pass @@ -307,9 +308,9 @@ subroutine open_boundary_impose_land_mask(OBC, G) ! bathymetry inside the boundary was do shallow and flagged as land. if (OBC%OBC_mask_u(I,j)) any_U = .true. enddo ; enddo - if (.not. any_U) then - deallocate(OBC%OBC_mask_u) - endif +! if (.not. any_U) then +! deallocate(OBC%OBC_mask_u) +! endif endif any_V = .false. @@ -317,12 +318,14 @@ subroutine open_boundary_impose_land_mask(OBC, G) do J=G%JsdB,G%JedB ; do i=G%isd,G%ied if (OBC%OBC_mask_v(i,J)) any_V = .true. enddo ; enddo - if (.not. any_V) then - deallocate(OBC%OBC_mask_v) - endif +! if (.not. any_V) then +! deallocate(OBC%OBC_mask_v) +! endif endif - if (.not.(any_U .or. any_V)) call open_boundary_dealloc(OBC) +! if (.not.(any_U .or. any_V)) call open_boundary_dealloc(OBC) + OBC%this_pe = .true. + if (.not.(any_U .or. any_V)) OBC%this_pe = .false. end subroutine open_boundary_impose_land_mask @@ -346,6 +349,7 @@ subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke if (.not.associated(OBC)) return + if (.not. OBC%this_pe) return if (.not.(OBC%apply_OBC_u_flather_east .or. OBC%apply_OBC_u_flather_west .or. & OBC%apply_OBC_v_flather_north .or. OBC%apply_OBC_v_flather_south)) & return @@ -567,8 +571,6 @@ subroutine set_Flather_positions(G, OBC) enddo ; enddo endif - ! If there are no OBC points on this PE, there is no reason to keep the OBC - ! type, and it could be deallocated. end subroutine set_Flather_positions !> Sets the initial definitions of the characteristic open boundary conditions. From 0cf849708fd5d9f6d67ce045a72d8b0c4881a267 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 29 Jun 2016 08:43:37 -0800 Subject: [PATCH 26/33] CCS1 runs with six cores. --- src/core/MOM_continuity_PPM.F90 | 6 +++--- src/core/MOM_open_boundary.F90 | 1 - src/parameterizations/lateral/MOM_hor_visc.F90 | 2 +- src/parameterizations/vertical/MOM_vert_friction.F90 | 2 +- src/tracer/MOM_tracer_advect.F90 | 4 ++-- 5 files changed, 7 insertions(+), 8 deletions(-) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 2562ca995f..43ef970e4f 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -192,7 +192,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, apply_OBC_u_flather_east = .false. ; apply_OBC_u_flather_west = .false. apply_OBC_v_flather_north = .false. ; apply_OBC_v_flather_south = .false. - if (present(OBC)) then ; if (associated(OBC)) then + if (present(OBC)) then ; if (OBC%this_pe) then apply_OBC_u_flather_east = OBC%apply_OBC_u_flather_east apply_OBC_u_flather_west = OBC%apply_OBC_u_flather_west apply_OBC_v_flather_north = OBC%apply_OBC_v_flather_north @@ -396,7 +396,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & use_visc_rem = present(visc_rem_u) apply_OBC_u = .false. ; set_BT_cont = .false. if (present(BT_cont)) set_BT_cont = (associated(BT_cont)) - if (present(OBC)) then ; if (associated(OBC)) then + if (present(OBC)) then ; if (OBC%this_pe) then apply_OBC_u = OBC%apply_OBC_u endif ; endif ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke @@ -1153,7 +1153,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & use_visc_rem = present(visc_rem_v) apply_OBC_v = .false. ; set_BT_cont = .false. if (present(BT_cont)) set_BT_cont = (associated(BT_cont)) - if (present(OBC)) then ; if (associated(OBC)) then + if (present(OBC)) then ; if (OBC%this_pe) then apply_OBC_v = OBC%apply_OBC_v endif ; endif ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index c1b5e6e011..b1af34a7df 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -349,7 +349,6 @@ subroutine Radiation_Open_Bdry_Conds(OBC, u_new, u_old, v_new, v_old, & is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke if (.not.associated(OBC)) return - if (.not. OBC%this_pe) return if (.not.(OBC%apply_OBC_u_flather_east .or. OBC%apply_OBC_u_flather_west .or. & OBC%apply_OBC_v_flather_north .or. OBC%apply_OBC_v_flather_south)) & return diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 897810c527..0f5cae38fe 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -298,7 +298,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, h_neglect = GV%H_subroundoff h_neglect3 = h_neglect**3 - if (present(OBC)) then ; if (associated(OBC)) then + if (present(OBC)) then ; if (OBC%this_pe) then apply_OBC = OBC%apply_OBC_u_flather_east .or. OBC%apply_OBC_u_flather_west .or. & OBC%apply_OBC_v_flather_north .or. OBC%apply_OBC_v_flather_south endif ; endif diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 7f32001ace..c624d049cb 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -388,7 +388,7 @@ subroutine vertvisc(u, v, h, fluxes, visc, dt, OBC, ADp, CDp, G, GV, CS, & call vertvisc_limit_vel(u, v, h, ADp, CDp, fluxes, visc, dt, G, GV, CS) ! Here the velocities associated with open boundary conditions are applied. - if (associated(OBC)) then + if (OBC%this_pe) then if (OBC%apply_OBC_u) then do k=1,nz ; do j=G%jsc,G%jec ; do I=Isq,Ieq if (OBC%OBC_mask_u(I,j) .and. (OBC%OBC_kind_u(I,j) == OBC_SIMPLE)) & diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 674a5f1e41..d7f9ef1883 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -470,7 +470,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & enddo ; enddo endif ! usePPM - if (associated(OBC)) then ; if (OBC%apply_OBC_u) then + if (OBC%this_pe) then ; if (OBC%apply_OBC_u) then do_any_i = .false. do I=is-1,ie do_i(I) = .false. @@ -730,7 +730,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & enddo ; enddo endif ! usePPM - if (associated(OBC)) then ; if (OBC%apply_OBC_v) then + if (OBC%this_pe) then ; if (OBC%apply_OBC_v) then do_any_i = .false. do i=is,ie do_i(i) = .false. From 5edb9c92e30cafe933078a72d5357200c47b94e1 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 29 Jun 2016 09:20:08 -0800 Subject: [PATCH 27/33] Merge of dev/master --- src/core/MOM_open_boundary.F90 | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 319fe378f6..2f638c317e 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -117,8 +117,6 @@ subroutine open_boundary_config(G, param_file, OBC) type(dyn_horgrid_type), intent(in) :: G !< Ocean grid structure type(param_file_type), intent(in) :: param_file !< Parameter file handle type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - ! Local variables - logical :: flather_east, flather_west, flather_north, flather_south allocate(OBC) @@ -471,22 +469,6 @@ subroutine set_Flather_positions(G, OBC) allocate(OBC%OBC_kind_v(G%isd:G%ied,G%JsdB:G%JedB)) ; OBC%OBC_kind_v(:,:) = OBC_NONE endif - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "APPLY_OBC_U_FLATHER_EAST", flather_east, & - "If true, some zonal velocity points use Flather open \n"//& - "boundary conditions on the east side of the ocean.", & - default=.false.) - call get_param(param_file, mod, "APPLY_OBC_U_FLATHER_WEST", flather_west, & - "If true, some zonal velocity points use Flather open \n"//& - "boundary conditions on the west side of the ocean.", & - default=.false.) - call get_param(param_file, mod, "APPLY_OBC_V_FLATHER_NORTH", flather_north, & - "If true, some meridional velocity points use Flather \n"//& - "open boundary conditions on the north side of the ocean.", & - default=.false.) - call get_param(param_file, mod, "APPLY_OBC_V_FLATHER_SOUTH", flather_south, & - "If true, some meridional velocity points use Flather \n"//& - "open boundary conditions on the north side of the ocean.", & ! This code should be modified to allow OBCs to be applied anywhere. if (G%symmetric) then From 3fa6245fd12985a2e726d1246b859b6aea3d0c21 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 29 Jun 2016 10:31:37 -0800 Subject: [PATCH 28/33] Fix for cases without OBC --- src/core/MOM_continuity_PPM.F90 | 12 ++++++------ src/core/MOM_open_boundary.F90 | 8 ++++---- src/parameterizations/lateral/MOM_hor_visc.F90 | 4 ++-- src/parameterizations/vertical/MOM_vert_friction.F90 | 4 ++-- src/tracer/MOM_tracer_advect.F90 | 8 ++++---- 5 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index ad0a6cf22b..63cacb96e6 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -192,7 +192,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, apply_OBC_u_flather_east = .false. ; apply_OBC_u_flather_west = .false. apply_OBC_v_flather_north = .false. ; apply_OBC_v_flather_south = .false. - if (present(OBC)) then ; if (OBC%this_pe) then + if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%this_pe) then apply_OBC_u_flather_east = OBC%apply_OBC_u_flather_east apply_OBC_u_flather_west = OBC%apply_OBC_u_flather_west apply_OBC_v_flather_north = OBC%apply_OBC_v_flather_north @@ -202,7 +202,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, if (apply_OBC_u_flather_east .or. apply_OBC_u_flather_west .or. & apply_OBC_v_flather_north .or. apply_OBC_v_flather_south) & h_input(:,:,:) = hin(:,:,:) - endif ; endif + endif ; endif ; endif if (present(visc_rem_u) .neqv. present(visc_rem_v)) call MOM_error(FATAL, & "MOM_continuity_PPM: Either both visc_rem_u and visc_rem_v or neither"// & @@ -396,9 +396,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & use_visc_rem = present(visc_rem_u) apply_OBC_u = .false. ; set_BT_cont = .false. if (present(BT_cont)) set_BT_cont = (associated(BT_cont)) - if (present(OBC)) then ; if (OBC%this_pe) then + if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%this_pe) then apply_OBC_u = OBC%apply_OBC_u - endif ; endif + endif ; endif ; endif ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke CFL_dt = CS%CFL_limit_adjust / dt @@ -1153,9 +1153,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & use_visc_rem = present(visc_rem_v) apply_OBC_v = .false. ; set_BT_cont = .false. if (present(BT_cont)) set_BT_cont = (associated(BT_cont)) - if (present(OBC)) then ; if (OBC%this_pe) then + if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%this_pe) then apply_OBC_v = OBC%apply_OBC_v - endif ; endif + endif ; endif ; endif ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke CFL_dt = CS%CFL_limit_adjust / dt diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 2f638c317e..357ef2cc52 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -1,5 +1,5 @@ ! This file is part of MOM6. See LICENSE.md for the license. -!> Controls where open boundary conditions are applied +!> Controls where open boundary conditions are applied module MOM_open_boundary ! This file is part of MOM6. See LICENSE.md for the license. @@ -595,8 +595,8 @@ subroutine set_Flather_data(OBC, tv, h, G, PF, tracer_Reg) real, pointer, dimension(:,:,:) :: & OBC_T_u => NULL(), & ! These arrays should be allocated and set to OBC_T_v => NULL(), & ! specify the values of T and S that should come - OBC_S_u => NULL(), & - OBC_S_v => NULL() + OBC_S_u => NULL(), & + OBC_S_v => NULL() is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -639,7 +639,7 @@ subroutine set_Flather_data(OBC, tv, h, G, PF, tracer_Reg) if (.not.associated(OBC%eta_outer_v)) then allocate(OBC%eta_outer_v(isd:ied,JsdB:JedB)) ; OBC%eta_outer_v(:,:) = 0.0 endif - + if (read_OBC_uv) then call read_data(filename, 'ubt', OBC%ubt_outer, & domain=G%Domain%mpp_domain, position=EAST_FACE) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 0f5cae38fe..78939b1f75 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -298,10 +298,10 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, h_neglect = GV%H_subroundoff h_neglect3 = h_neglect**3 - if (present(OBC)) then ; if (OBC%this_pe) then + if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%this_pe) then apply_OBC = OBC%apply_OBC_u_flather_east .or. OBC%apply_OBC_u_flather_west .or. & OBC%apply_OBC_v_flather_north .or. OBC%apply_OBC_v_flather_south - endif ; endif + endif ; endif ; endif if (.not.associated(CS)) call MOM_error(FATAL, & "MOM_hor_visc: Module must be initialized before it is used.") diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index c624d049cb..cca1f7807a 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -388,7 +388,7 @@ subroutine vertvisc(u, v, h, fluxes, visc, dt, OBC, ADp, CDp, G, GV, CS, & call vertvisc_limit_vel(u, v, h, ADp, CDp, fluxes, visc, dt, G, GV, CS) ! Here the velocities associated with open boundary conditions are applied. - if (OBC%this_pe) then + if (associated(OBC)) then ; if (OBC%this_pe) then if (OBC%apply_OBC_u) then do k=1,nz ; do j=G%jsc,G%jec ; do I=Isq,Ieq if (OBC%OBC_mask_u(I,j) .and. (OBC%OBC_kind_u(I,j) == OBC_SIMPLE)) & @@ -401,7 +401,7 @@ subroutine vertvisc(u, v, h, fluxes, visc, dt, OBC, ADp, CDp, G, GV, CS, & v(i,J,k) = OBC%v(i,J,k) enddo ; enddo ; enddo endif - endif + endif ; endif ! Offer diagnostic fields for averaging. if (CS%id_du_dt_visc > 0) & call post_data(CS%id_du_dt_visc, ADp%du_dt_visc, CS%diag) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index d7f9ef1883..9686dc7eb2 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -470,7 +470,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & enddo ; enddo endif ! usePPM - if (OBC%this_pe) then ; if (OBC%apply_OBC_u) then + if (associated(OBC)) then ; if (OBC%this_pe) then ; if (OBC%apply_OBC_u) then do_any_i = .false. do I=is-1,ie do_i(I) = .false. @@ -491,7 +491,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & flux_x(I,m) = uhh(I)*Tr(m)%OBC_in_u(I,j,k) else ; flux_x(I,m) = uhh(I)*Tr(m)%OBC_inflow_conc ; endif endif ; enddo ; enddo ; endif - endif ; endif + endif ; endif ; endif ! Calculate new tracer concentration in each cell after accounting ! for the i-direction fluxes. @@ -730,7 +730,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & enddo ; enddo endif ! usePPM - if (OBC%this_pe) then ; if (OBC%apply_OBC_v) then + if (associated(OBC)) then ; if (OBC%this_pe) then ; if (OBC%apply_OBC_v) then do_any_i = .false. do i=is,ie do_i(i) = .false. @@ -751,7 +751,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & flux_y(i,m,J) = vhh(i,J)*Tr(m)%OBC_in_v(i,J,k) else ; flux_y(i,m,J) = vhh(i,J)*Tr(m)%OBC_inflow_conc ; endif endif ; enddo ; enddo ; endif - endif ; endif + endif ; endif ; endif else ! not domore_v. do i=is,ie ; vhh(i,J) = 0.0 ; enddo do m=1,ntr ; do i=is,ie ; flux_y(i,m,J) = 0.0 ; enddo ; enddo From 6ee04ef36c6968d2f98df7d73a6cc5f7345d047d Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Wed, 29 Jun 2016 19:34:25 -0800 Subject: [PATCH 29/33] Backing out unstable change to OBC --- src/core/MOM_continuity_PPM.F90 | 52 ++++++++++++++++----------------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 86d05a15b4..3ee272122e 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -237,14 +237,14 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, h(i,j,k) = h_input(i+1,j,k) enddo enddo - do J=LB%jsh-1,LB%jeh - do i=LB%ish-1,LB%ieh+1 - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_E)) & - v(i,J,k) = v(i-1,J,k) - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_W)) & - v(i,J,k) = v(i+1,J,k) +! do J=LB%jsh-1,LB%jeh +! do i=LB%ish-1,LB%ieh+1 +! if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_E)) & +! v(i,J,k) = v(i-1,J,k) +! if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_W)) & +! v(i,J,k) = v(i+1,J,k) enddo - enddo ; enddo +! enddo ; enddo endif LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec @@ -272,12 +272,12 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S)) & h(i,j,k) = h_input(i,j+1,k) enddo ; enddo - do j=LB%jsh-1,LB%jeh+1 ; do I=LB%ish-1,LB%ieh - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_N)) & - u(I,j,k) = u(I,j-1,k) - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_S)) & - u(I,j,k) = u(I,j+1,k) - enddo ; enddo +! do j=LB%jsh-1,LB%jeh+1 ; do I=LB%ish-1,LB%ieh +! if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_N)) & +! u(I,j,k) = u(I,j-1,k) +! if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_S)) & +! u(I,j,k) = u(I,j+1,k) +! enddo ; enddo enddo endif else ! .not. x_first @@ -305,12 +305,12 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S)) & h(i,j,k) = h_input(i,j+1,k) enddo ; enddo - do j=LB%jsh-1,LB%jeh+1 ; do I=LB%ish-1,LB%ieh - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_N)) & - u(I,j,k) = u(I,j-1,k) - if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_S)) & - u(I,j,k) = u(I,j+1,k) - enddo ; enddo +! do j=LB%jsh-1,LB%jeh+1 ; do I=LB%ish-1,LB%ieh +! if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_N)) & +! u(I,j,k) = u(I,j-1,k) +! if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_S)) & +! u(I,j,k) = u(I,j+1,k) +! enddo ; enddo enddo endif @@ -340,14 +340,14 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, h(i,j,k) = h_input(i+1,j,k) enddo enddo - do J=LB%jsh-1,LB%jeh - do i=LB%ish-1,LB%ieh+1 - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_E)) & - v(i,J,k) = v(i-1,J,k) - if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_W)) & - v(i,J,k) = v(i+1,J,k) +! do J=LB%jsh-1,LB%jeh +! do i=LB%ish-1,LB%ieh+1 +! if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_E)) & +! v(i,J,k) = v(i-1,J,k) +! if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_W)) & +! v(i,J,k) = v(i+1,J,k) enddo - enddo ; enddo +! enddo ; enddo endif endif From 8cb5593dff4b291aa1b41a4b315db98b1f873e3d Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Thu, 30 Jun 2016 14:27:47 -0800 Subject: [PATCH 30/33] Changed do_i test for Flather OBC --- src/core/MOM_continuity_PPM.F90 | 156 ++++++++++++++++++-------------- 1 file changed, 86 insertions(+), 70 deletions(-) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 3ee272122e..41a06f0830 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -19,30 +19,6 @@ module MOM_continuity_PPM !* or see: http://www.gnu.org/licenses/gpl.html * !*********************************************************************** -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg and Alistair Adcroft, September 2006 - . * -!* * -!* This program contains the subroutine that advects layer * -!* thickness. The scheme here uses a Piecewise-Parabolic method with * -!* a positive definite limiter. * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v, vh * -!* j x ^ x ^ x At >: u, uh * -!* j > o > o > At o: h, hin * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : time_type, diag_ctrl use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe @@ -105,10 +81,13 @@ module MOM_continuity_PPM contains +!> This subroutine time steps the layer thicknesses, using a monotonically +! limit, directionally split PPM scheme, based on Lin (1994). In the following +! documentation, H is used for the units of thickness (usually m or kg m-2.) subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & visc_rem_u, visc_rem_v, u_cor, v_cor, & uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) - type(ocean_grid_type), intent(inout) :: G + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(continuity_PPM_CS), pointer :: CS real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v @@ -130,9 +109,6 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out), optional :: u_cor_aux real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out), optional :: v_cor_aux type(BT_cont_type), pointer, optional :: BT_cont -! This subroutine time steps the layer thicknesses, using a monotonically -! limit, directionally split PPM scheme, based on Lin (1994). In the following -! documentation, H is used for the units of thickness (usually m or kg m-2.) ! Arguments: u - Zonal velocity, in m s-1. ! (in) v - Meridional velocity, in m s-1. @@ -237,14 +213,14 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, h(i,j,k) = h_input(i+1,j,k) enddo enddo -! do J=LB%jsh-1,LB%jeh -! do i=LB%ish-1,LB%ieh+1 -! if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_E)) & -! v(i,J,k) = v(i-1,J,k) -! if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_W)) & -! v(i,J,k) = v(i+1,J,k) + do J=LB%jsh-1,LB%jeh + do i=LB%ish-1,LB%ieh+1 + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_E)) & + v(i,J,k) = v(i-1,J,k) + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_W)) & + v(i,J,k) = v(i+1,J,k) enddo -! enddo ; enddo + enddo ; enddo endif LB%ish = G%isc ; LB%ieh = G%iec ; LB%jsh = G%jsc ; LB%jeh = G%jec @@ -272,12 +248,12 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S)) & h(i,j,k) = h_input(i,j+1,k) enddo ; enddo -! do j=LB%jsh-1,LB%jeh+1 ; do I=LB%ish-1,LB%ieh -! if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_N)) & -! u(I,j,k) = u(I,j-1,k) -! if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_S)) & -! u(I,j,k) = u(I,j+1,k) -! enddo ; enddo + do j=LB%jsh-1,LB%jeh+1 ; do I=LB%ish-1,LB%ieh + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_N)) & + u(I,j,k) = u(I,j-1,k) + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_S)) & + u(I,j,k) = u(I,j+1,k) + enddo ; enddo enddo endif else ! .not. x_first @@ -305,12 +281,12 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_S)) & h(i,j,k) = h_input(i,j+1,k) enddo ; enddo -! do j=LB%jsh-1,LB%jeh+1 ; do I=LB%ish-1,LB%ieh -! if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_N)) & -! u(I,j,k) = u(I,j-1,k) -! if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_S)) & -! u(I,j,k) = u(I,j+1,k) -! enddo ; enddo + do j=LB%jsh-1,LB%jeh+1 ; do I=LB%ish-1,LB%ieh + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_N)) & + u(I,j,k) = u(I,j-1,k) + if (OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_S)) & + u(I,j,k) = u(I,j+1,k) + enddo ; enddo enddo endif @@ -340,14 +316,14 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, h(i,j,k) = h_input(i+1,j,k) enddo enddo -! do J=LB%jsh-1,LB%jeh -! do i=LB%ish-1,LB%ieh+1 -! if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_E)) & -! v(i,J,k) = v(i-1,J,k) -! if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_W)) & -! v(i,J,k) = v(i+1,J,k) + do J=LB%jsh-1,LB%jeh + do i=LB%ish-1,LB%ieh+1 + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_E)) & + v(i,J,k) = v(i-1,J,k) + if (OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_W)) & + v(i,J,k) = v(i+1,J,k) enddo -! enddo ; enddo + enddo ; enddo endif endif @@ -419,14 +395,19 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & real :: dx_E, dx_W ! Effective x-grid spacings to the east and west, in m. integer :: i, j, k, ish, ieh, jsh, jeh, nz logical :: do_aux, apply_OBC_u, use_visc_rem, set_BT_cont, any_simple_OBC + logical :: apply_OBC_flather do_aux = (present(uhbt_aux) .and. present(u_cor_aux)) use_visc_rem = present(visc_rem_u) apply_OBC_u = .false. ; set_BT_cont = .false. if (present(BT_cont)) set_BT_cont = (associated(BT_cont)) - if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%this_pe) then + if (present(OBC)) then ; if (associated(OBC)) then apply_OBC_u = OBC%apply_OBC_u - endif ; endif ; endif + apply_OBC_flather = OBC%apply_OBC_u_flather_east .or. & + OBC%apply_OBC_u_flather_west .or. & + OBC%apply_OBC_v_flather_north .or. & + OBC%apply_OBC_v_flather_south + endif ; endif ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke CFL_dt = CS%CFL_limit_adjust / dt @@ -558,12 +539,16 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & any_simple_OBC = .false. if (present(uhbt) .or. do_aux .or. set_BT_cont) then - if (.not.apply_OBC_u) then ; do I=ish-1,ieh - do_i(I) = .true. - enddo ; else ; do I=ish-1,ieh - do_i(I) = .not.(OBC%OBC_mask_u(I,j) .and. & - (OBC%OBC_kind_u(I,j) == OBC_SIMPLE)) + if (apply_OBC_u) then ; do I=ish-1,ieh + do_i(I) = .not.(OBC%OBC_mask_u(I,j)) if (.not.do_i(I)) any_simple_OBC = .true. + enddo ; else if (apply_OBC_flather) then ; do I=ish-1,ieh + do_i(I) = .not.(OBC%OBC_mask_u(I,j) .and. & + OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. & + (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_N .or. & + OBC%OBC_direction_u(I,j) == OBC_DIRECTION_S)) + enddo ; else ; do I=ish-1,ieh + do_i(I) = .true. enddo ; endif endif @@ -602,8 +587,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & visc_rem_max, j, ish, ieh, do_i) if (any_simple_OBC) then do I=ish-1,ieh - do_i(I) = (OBC%OBC_mask_u(I,j) .and. & - (OBC%OBC_kind_u(I,j) == OBC_SIMPLE)) + do_i(I) = (OBC%OBC_mask_u(I,j)) if (do_i(I)) BT_cont%Fa_u_W0(I,j) = GV%H_subroundoff*G%dy_Cu(I,j) enddo do k=1,nz ; do I=ish-1,ieh ; if (do_i(I)) then @@ -1176,6 +1160,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & real :: dy_N, dy_S ! Effective y-grid spacings to the north and south, in m. integer :: i, j, k, ish, ieh, jsh, jeh, nz logical :: do_aux, apply_OBC_v, use_visc_rem, set_BT_cont, any_simple_OBC + logical :: apply_OBC_flather do_aux = (present(vhbt_aux) .and. present(v_cor_aux)) use_visc_rem = present(visc_rem_v) @@ -1183,6 +1168,10 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & if (present(BT_cont)) set_BT_cont = (associated(BT_cont)) if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%this_pe) then apply_OBC_v = OBC%apply_OBC_v + apply_OBC_flather = OBC%apply_OBC_u_flather_east .or. & + OBC%apply_OBC_u_flather_west .or. & + OBC%apply_OBC_v_flather_north .or. & + OBC%apply_OBC_v_flather_south endif ; endif ; endif ish = LB%ish ; ieh = LB%ieh ; jsh = LB%jsh ; jeh = LB%jeh ; nz = G%ke @@ -1313,12 +1302,16 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & any_simple_OBC = .false. if (present(vhbt) .or. do_aux .or. set_BT_cont) then - if (.not.apply_OBC_v) then ; do i=ish,ieh - do_i(i) = .true. - enddo ; else ; do i=ish,ieh + if (apply_OBC_v) then ; do i=ish,ieh + do_i(i) = .not.(OBC%OBC_mask_v(i,J)) + if (.not.do_i(i)) any_simple_OBC = .true. + enddo ; else if (apply_OBC_flather) then ; do i=ish,ieh do_i(i) = .not.(OBC%OBC_mask_v(i,J) .and. & - (OBC%OBC_kind_v(i,J) == OBC_SIMPLE)) - if (.not.do_i(I)) any_simple_OBC = .true. + OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. & + (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_E .or. & + OBC%OBC_direction_v(i,J) == OBC_DIRECTION_W)) + enddo ; else ; do i=ish,ieh + do_i(i) = .true. enddo ; endif endif @@ -1356,8 +1349,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & visc_rem_max, J, ish, ieh, do_i) if (any_simple_OBC) then do i=ish,ieh - do_i(i) = (OBC%OBC_mask_v(i,J) .and. & - (OBC%OBC_kind_v(i,J) == OBC_SIMPLE)) + do_i(i) = (OBC%OBC_mask_v(i,J)) if (do_i(i)) BT_cont%Fa_v_S0(i,J) = GV%H_subroundoff*G%dx_Cv(I,j) enddo do k=1,nz ; do i=ish,ieh ; if (do_i(i)) then @@ -2242,4 +2234,28 @@ subroutine continuity_PPM_end(CS) deallocate(CS) end subroutine continuity_PPM_end +!********+*********+*********+*********+*********+*********+*********+** +!* * +!* By Robert Hallberg and Alistair Adcroft, September 2006 - . * +!* * +!* This program contains the subroutine that advects layer * +!* thickness. The scheme here uses a Piecewise-Parabolic method with * +!* a positive definite limiter. * +!* * +!* Macros written all in capital letters are defined in MOM_memory.h. * +!* * +!* A small fragment of the grid is shown below: * +!* * +!* j+1 x ^ x ^ x At x: q * +!* j+1 > o > o > At ^: v, vh * +!* j x ^ x ^ x At >: u, uh * +!* j > o > o > At o: h, hin * +!* j-1 x ^ x ^ x * +!* i-1 i i+1 At x & ^: * +!* i i+1 At > & o: * +!* * +!* The boundaries always run through q grid points (x). * +!* * +!********+*********+*********+*********+*********+*********+*********+** + end module MOM_continuity_PPM From 12b8cc57476a3749aa4d9f0549dc94c8b1961eeb Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Thu, 30 Jun 2016 22:03:35 -0800 Subject: [PATCH 31/33] Put back OBC_SIMPLE tests. --- src/core/MOM_continuity_PPM.F90 | 263 +++++++++++++++----------------- 1 file changed, 124 insertions(+), 139 deletions(-) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 41a06f0830..57e4c6f3cc 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -82,68 +82,56 @@ module MOM_continuity_PPM contains !> This subroutine time steps the layer thicknesses, using a monotonically -! limit, directionally split PPM scheme, based on Lin (1994). In the following -! documentation, H is used for the units of thickness (usually m or kg m-2.) +!! limit, directionally split PPM scheme, based on Lin (1994). In the following +!! documentation, H is used for the units of thickness (usually m or kg m-2.) subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, & visc_rem_u, visc_rem_v, u_cor, v_cor, & uhbt_aux, vhbt_aux, u_cor_aux, v_cor_aux, BT_cont) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. - type(continuity_PPM_CS), pointer :: CS - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hin - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uh - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vh - real, intent(in) :: dt - type(verticalGrid_type), intent(in) :: GV - real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt - real, dimension(SZI_(G),SZJB_(G)), intent(in), optional :: vhbt - type(ocean_OBC_type), pointer, optional :: OBC - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in), optional :: visc_rem_u - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in), optional :: visc_rem_v - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out), optional :: u_cor - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out), optional :: v_cor - real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt_aux - real, dimension(SZI_(G),SZJB_(G)), intent(in), optional :: vhbt_aux - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out), optional :: u_cor_aux - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out), optional :: v_cor_aux - type(BT_cont_type), pointer, optional :: BT_cont - -! Arguments: u - Zonal velocity, in m s-1. -! (in) v - Meridional velocity, in m s-1. -! (in) hin - Initial layer thickness, in H. -! (out) h - Final layer thickness, in H. -! (out) uh - Volume flux through zonal faces = u*h*dy, H m2 s-1. -! (out) vh - Volume flux through meridional faces = v*h*dx, -! in H m2 s-1. -! (in) dt - Time increment in s. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! continuity_PPM_init. -! (in, opt) uhbt - The summed volume flux through zonal faces, H m2 s-1. -! (in, opt) vhbt - The summed volume flux through meridional faces, H m2 s-1. -! (in, opt) OBC - This open boundary condition type specifies whether, where, -! and what open boundary conditions are used. -! (in, opt) visc_rem_u - Both the fraction of the momentum originally in a -! (in, opt) visc_rem_v - layer that remains after a time-step of viscosity, -! and the fraction of a time-step's worth of a -! barotropic acceleration that a layer experiences -! after viscosity is applied, in the zonal (_u) and -! meridional (_v) directions. Nondimensional between -! 0 (at the bottom) and 1 (far above the bottom). -! (out, opt) u_cor - The zonal velocities that give uhbt as the depth- -! integrated transport, in m s-1. -! (out, opt) v_cor - The meridional velocities that give vhbt as the -! depth-integrated transport, in m s-1. -! (in, opt) uhbt_aux - A second set of summed volume fluxes through zonal -! (in, opt) vhbt_aux - and meridional faces, both in H m2 s-1. -! (out, opt) u_cor_aux - The zonal and meridional velocities that give uhbt_aux -! (out, opt) v_cor_aux - and vhbt_aux as the depth-integrated transports, -! both in m s-1. -! (out, opt) BT_cont - A structure with elements that describe the effective -! open face areas as a function of barotropic flow. + type(continuity_PPM_CS), pointer :: CS !< Module's control structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< Zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< Meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hin !< Initial layer thickness, in H. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Final layer thickness, in H. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uh !< Zonal volume flux, + !! u*h*dy, H m2 s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: vh !< Meridional volume flux, + !! v*h*dx, H m2 s-1. + real, intent(in) :: dt !< Time increment in s. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt !< + !! The summed volume flux through zonal faces, H m2 s-1. + real, dimension(SZI_(G),SZJB_(G)), intent(in), optional :: vhbt !< + !! The summed volume flux through meridional faces, H m2 s-1. + type(ocean_OBC_type), pointer, optional :: OBC !< + !! This open boundary condition type specifies whether, where, + !! and what open boundary conditions are used. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in), optional :: visc_rem_u !< + !! Both the fraction of the momentum originally in a layer that remains after a time-step + !! of viscosity, and the fraction of a time-step's worth of a barotropic acceleration that + !! a layer experiences after viscosity is applied, in the zonal (_u) + !! direction. Nondimensional between 0 (at the bottom) and 1 (far above the bottom). + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in), optional :: visc_rem_v !< + !! Same as above for meridional direction. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out), optional :: u_cor !< + !! The zonal velocities that give uhbt as the depth- + !! integrated transport, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out), optional :: v_cor !< + !! The meridional velocities that give vhbt as the + !! depth-integrated transport, in m s-1. + real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt_aux !< + !! A second set of summed volume fluxes through zonal faces, in H m2 s-1. + real, dimension(SZI_(G),SZJB_(G)), intent(in), optional :: vhbt_aux !< + !! A second set of summed volume fluxes through meridional faces, in H m2 s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out), optional :: u_cor_aux !< + !! The zonal velocities that give uhbt_aux as the + !! depth-integrated transports, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out), optional :: v_cor_aux !< + !! The meridional velocities that give vhbt_aux as the + !! depth-integrated transports, in m s-1. + type(BT_cont_type), pointer, optional :: BT_cont !< + !! A structure with elements that describe the effective + !! open face areas as a function of barotropic flow. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & h_input ! Left and right face thicknesses, in H. @@ -329,49 +317,44 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, end subroutine continuity_PPM +!> This subroutine calculates the mass or volume fluxes through the zonal +!! faces, and other related quantities. subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & visc_rem_u, u_cor, uhbt_aux, u_cor_aux, BT_cont) - type(ocean_grid_type), intent(inout) :: G - type(verticalGrid_type), intent(in) :: GV - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uh - real, intent(in) :: dt - type(continuity_PPM_CS), pointer :: CS - type(loop_bounds_type), intent(in) :: LB - type(ocean_OBC_type), pointer, optional :: OBC - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in), optional :: visc_rem_u - real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt, uhbt_aux - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out), optional :: u_cor, u_cor_aux - type(BT_cont_type), pointer, optional :: BT_cont -! This subroutine calculates the mass or volume fluxes through the zonal -! faces, and other related quantities. -! Arguments: u - Zonal velocity, in m s-1. -! (in) h_in - Layer thickness used to calculate the fluxes, in H. -! (out) uh - Volume flux through zonal faces = u*h*dy, H m2 s-1. -! (in) dt - Time increment in s. -! (in) G - The ocean's grid structure. -! (in) CS - The control structure returned by a previous call to -! continuity_PPM_init. -! (in) LB - A structure with the active loop bounds. -! (in, opt) uhbt - The summed volume flux through zonal faces, H m2 s-1. -! (in, opt) OBC - This open boundary condition type specifies whether, where, -! and what open boundary conditions are used. -! (in, opt) visc_rem_u - Both the fraction of the momentum originally in a -! layer that remains after a time-step of viscosity, -! and the fraction of a time-step's worth of a -! barotropic acceleration that a layer experiences -! after viscosity is applied. Nondimensional between -! 0 (at the bottom) and 1 (far above the bottom). -! (out, opt) u_cor - The zonal velocitiess (u with a barotropic correction) -! that give uhbt as the depth-integrated transport, m s-1. -! (in, opt) uhbt_aux - A second set of summed volume fluxes through zonal -! faces, in H m2 s-1. -! (out, opt) u_cor_aux - The zonal velocities (u with a barotropic correction) -! that give uhbt_aux as the depth-integrated transports, -! in m s-1. -! (out, opt) BT_cont - A structure with elements that describe the effective -! open face areas as a function of barotropic flow. + type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< Ocean's vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_in !< Layer thickness used to + !! calculate fluxes, in H. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: uh !< Volume flux through zonal + !! faces = u*h*dy, H m2 s-1. + real, intent(in) :: dt !< Time increment in s. + type(continuity_PPM_CS), pointer :: CS !< This module's control structure. + type(loop_bounds_type), intent(in) :: LB !< Loop bounds structure. + type(ocean_OBC_type), pointer, optional :: OBC !< + !! This open boundary condition type specifies whether, where, + !! and what open boundary conditions are used. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in), optional :: visc_rem_u !< + !! Both the fraction of the momentum originally in a + !! layer that remains after a time-step of viscosity, + !! and the fraction of a time-step's worth of a + !! barotropic acceleration that a layer experiences + !! after viscosity is applied. Nondimensional between + !! 0 (at the bottom) and 1 (far above the bottom). + real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt !< + !! The summed volume flux through zonal faces, H m2 s-1. + real, dimension(SZIB_(G),SZJ_(G)), intent(in), optional :: uhbt_aux !< + !! A second set of summed volume fluxes through zonal + !! faces, in H m2 s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out), optional :: u_cor !< + !! The zonal velocitiess (u with a barotropic correction) + !! that give uhbt as the depth-integrated transport, m s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out), optional :: u_cor_aux !< + !! The zonal velocities (u with a barotropic correction) + !! that give uhbt_aux as the depth-integrated transports, in m s-1. + type(BT_cont_type), pointer, optional :: BT_cont !< + !! A structure with elements that describe the effective + !! open face areas as a function of barotropic flow. real, dimension(SZIB_(G),SZK_(G)) :: & duhdu ! Partial derivative of uh with u, in H m. @@ -540,13 +523,14 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & any_simple_OBC = .false. if (present(uhbt) .or. do_aux .or. set_BT_cont) then if (apply_OBC_u) then ; do I=ish-1,ieh - do_i(I) = .not.(OBC%OBC_mask_u(I,j)) + do_i(I) = .not.(OBC%OBC_mask_u(I,j) .and. & + (OBC%OBC_kind_u(I,j) == OBC_SIMPLE)) if (.not.do_i(I)) any_simple_OBC = .true. enddo ; else if (apply_OBC_flather) then ; do I=ish-1,ieh do_i(I) = .not.(OBC%OBC_mask_u(I,j) .and. & - OBC%OBC_kind_u(I,j) == OBC_FLATHER .and. & - (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_N .or. & - OBC%OBC_direction_u(I,j) == OBC_DIRECTION_S)) + (OBC%OBC_kind_u(I,j) == OBC_FLATHER) .and. & + ((OBC%OBC_direction_u(I,j) == OBC_DIRECTION_N) .or. & + (OBC%OBC_direction_u(I,j) == OBC_DIRECTION_S))) enddo ; else ; do I=ish-1,ieh do_i(I) = .true. enddo ; endif @@ -587,7 +571,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & visc_rem_max, j, ish, ieh, do_i) if (any_simple_OBC) then do I=ish-1,ieh - do_i(I) = (OBC%OBC_mask_u(I,j)) + do_i(I) = (OBC%OBC_mask_u(I,j) .and. & + (OBC%OBC_kind_u(I,j) == OBC_SIMPLE)) if (do_i(I)) BT_cont%Fa_u_W0(I,j) = GV%H_subroundoff*G%dy_Cu(I,j) enddo do k=1,nz ; do I=ish-1,ieh ; if (do_i(I)) then @@ -619,35 +604,31 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & end subroutine zonal_mass_flux +!> This subroutines evaluates the zonal mass or volume fluxes in a layer. subroutine zonal_flux_layer(u, h, hL, hR, uh, duhdu, visc_rem, dt, G, j, & ish, ieh, do_i, vol_CFL) - type(ocean_grid_type), intent(inout) :: G - real, dimension(SZIB_(G)), intent(in) :: u, visc_rem - real, dimension(SZI_(G)), intent(in) :: h, hL, hR - real, dimension(SZIB_(G)), intent(inout) :: uh, duhdu - real, intent(in) :: dt - integer, intent(in) :: j, ish, ieh - logical, dimension(SZIB_(G)), intent(in) :: do_i - logical, intent(in) :: vol_CFL -! This subroutines evaluates the zonal mass or volume fluxes in a layer. -! -! Arguments: u - Zonal velocity, in m s-1. -! (in) h - Layer thickness used to calculate the fluxes, in H. -! (in) hL, hR - Left- and right- thicknesses in the reconstruction, in H. -! (out) uh - The zonal mass or volume transport, in H m2 s-1. -! (out) duhdu - The partial derivative of uh with u, in H m. -! (in) dt - Time increment in s. -! (in) G - The ocean's grid structure. -! (in) visc_rem - Both the fraction of the momentum originally in a -! layer that remains after a time-step of viscosity, -! and the fraction of a time-step's worth of a -! barotropic acceleration that a layer experiences -! after viscosity is applied. Nondimensional between -! 0 (at the bottom) and 1 (far above the bottom). -! (in) j, ish, ieh - The index range to work on. -! (in) do_i - A logical flag indiciating which I values to work on. -! (in) vol_CFL - If true, rescale the ratio of face areas to the cell -! areas when estimating the CFL number. + type(ocean_grid_type), intent(inout) :: G !< Ocean's grid structure. + real, dimension(SZIB_(G)), intent(in) :: u !< Zonal velocity, in m s-1. + real, dimension(SZIB_(G)), intent(in) :: visc_rem !< Both the fraction of the + !! momentum originally in a layer that remains after a time-step + !! of viscosity, and the fraction of a time-step's worth of a barotropic + !! acceleration that a layer experiences after viscosity is applied. + !! Nondimensional between 0 (at the bottom) and 1 (far above the bottom). + real, dimension(SZI_(G)), intent(in) :: h !< Layer thickness, in H. + real, dimension(SZI_(G)), intent(in) :: hL !< Left thickness, in H. + real, dimension(SZI_(G)), intent(in) :: hR !< Right thickness, in H. + real, dimension(SZIB_(G)), intent(inout) :: uh !< Zonal mass or volume + !! transport, in H m2 s-1. + real, dimension(SZIB_(G)), intent(inout) :: duhdu !< Partial derivative of uh + !! with u, in H m. + real, intent(in) :: dt !< Time increment in s. + integer, intent(in) :: j !< Spatial index. + integer, intent(in) :: ish !< Start of index range. + integer, intent(in) :: ieh !< End of index range. + logical, dimension(SZIB_(G)), intent(in) :: do_i !< Which i values to work on. + logical, intent(in) :: vol_CFL !< If true, rescale the + !! ratio of face areas to the cell areas when estimating the CFL number. + real :: CFL ! The CFL number based on the local velocity and grid spacing, ND. real :: curv_3 ! A measure of the thickness curvature over a grid length, ! with the same units as h_in. @@ -679,19 +660,21 @@ subroutine zonal_flux_layer(u, h, hL, hR, uh, duhdu, visc_rem, dt, G, j, & end subroutine zonal_flux_layer +!> This subroutines sets the effective interface thickness at each zonal +!! velocity point. subroutine zonal_face_thickness(u, h, hL, hR, h_u, dt, G, LB, vol_CFL, & marginal, visc_rem_u) type(ocean_grid_type), intent(inout) :: G real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h, hL, hR + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hL + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hR real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_u real, intent(in) :: dt type(loop_bounds_type), intent(in) :: LB logical, intent(in) :: vol_CFL logical, intent(in) :: marginal real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in), optional :: visc_rem_u -! This subroutines sets the effective interface thickness at each zonal -! velocity point. ! ! Arguments: u - Zonal velocity, in m s-1. ! (in) h - Layer thickness used to calculate the fluxes, in H. @@ -1303,13 +1286,14 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & any_simple_OBC = .false. if (present(vhbt) .or. do_aux .or. set_BT_cont) then if (apply_OBC_v) then ; do i=ish,ieh - do_i(i) = .not.(OBC%OBC_mask_v(i,J)) + do_i(i) = .not.(OBC%OBC_mask_v(i,J) .and. & + (OBC%OBC_kind_v(i,J) == OBC_SIMPLE)) if (.not.do_i(i)) any_simple_OBC = .true. enddo ; else if (apply_OBC_flather) then ; do i=ish,ieh do_i(i) = .not.(OBC%OBC_mask_v(i,J) .and. & - OBC%OBC_kind_v(i,J) == OBC_FLATHER .and. & - (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_E .or. & - OBC%OBC_direction_v(i,J) == OBC_DIRECTION_W)) + (OBC%OBC_kind_v(i,J) == OBC_FLATHER) .and. & + ((OBC%OBC_direction_v(i,J) == OBC_DIRECTION_E) .or. & + (OBC%OBC_direction_v(i,J) == OBC_DIRECTION_W))) enddo ; else ; do i=ish,ieh do_i(i) = .true. enddo ; endif @@ -1349,7 +1333,8 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & visc_rem_max, J, ish, ieh, do_i) if (any_simple_OBC) then do i=ish,ieh - do_i(i) = (OBC%OBC_mask_v(i,J)) + do_i(i) = (OBC%OBC_mask_v(i,J) .and. & + (OBC%OBC_kind_v(i,J) == OBC_SIMPLE)) if (do_i(i)) BT_cont%Fa_v_S0(i,J) = GV%H_subroundoff*G%dx_Cv(I,j) enddo do k=1,nz ; do i=ish,ieh ; if (do_i(i)) then From cff9f0e0b60cf09e9c5192c275220ec9d6c7d084 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 1 Jul 2016 15:42:04 -0400 Subject: [PATCH 32/33] Fixed uninitialized logical in MOM_continuity_PPM - A logical used to indicate use of Flather OBCs was not always set. Detected in coupled-mode executables for some reasons. - No answer changes. --- src/core/MOM_continuity_PPM.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 57e4c6f3cc..6529de4474 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -382,7 +382,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & do_aux = (present(uhbt_aux) .and. present(u_cor_aux)) use_visc_rem = present(visc_rem_u) - apply_OBC_u = .false. ; set_BT_cont = .false. + apply_OBC_u = .false. ; set_BT_cont = .false. ; apply_OBC_flather = .false. if (present(BT_cont)) set_BT_cont = (associated(BT_cont)) if (present(OBC)) then ; if (associated(OBC)) then apply_OBC_u = OBC%apply_OBC_u @@ -1147,7 +1147,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & do_aux = (present(vhbt_aux) .and. present(v_cor_aux)) use_visc_rem = present(visc_rem_v) - apply_OBC_v = .false. ; set_BT_cont = .false. + apply_OBC_v = .false. ; set_BT_cont = .false. ; apply_OBC_flather = .false. if (present(BT_cont)) set_BT_cont = (associated(BT_cont)) if (present(OBC)) then ; if (associated(OBC)) then ; if (OBC%this_pe) then apply_OBC_v = OBC%apply_OBC_v From be8080a0ce2f592efe98b59e81dce153035b0524 Mon Sep 17 00:00:00 2001 From: Alistair Adcroft Date: Fri, 1 Jul 2016 16:07:15 -0400 Subject: [PATCH 33/33] Added description for log_version in MOM_open_boundary - We now require log_version to have a description for module logging so that parameters are logged in MOM_parameter_doc.* files in labeled regions. - No answer changes. --- src/core/MOM_open_boundary.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 357ef2cc52..d1bd34d6ad 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -120,7 +120,8 @@ subroutine open_boundary_config(G, param_file, OBC) allocate(OBC) - call log_version(param_file, mod, version) + call log_version(param_file, mod, version, "Controls where open boundaries are located, what "//& + "kind of boundary condition to impose, and what data to apply, if any.") call get_param(param_file, mod, "APPLY_OBC_U", OBC%apply_OBC_u, & "If true, open boundary conditions may be set at some \n"//& "u-points, with the configuration controlled by OBC_CONFIG", &