OBC registry

src/core/MOM.F90

@@ -66,6 +66,7 @@ module MOM
 use MOM_ALE,                   only : ALE_init, ALE_end, ALE_main, ALE_CS, adjustGridForIntegrity
 use MOM_ALE,                   only : ALE_getCoordinate, ALE_getCoordinateUnits, ALE_writeCoordinateFile
 use MOM_ALE,                   only : ALE_updateVerticalGridType, ALE_remap_init_conds, ALE_register_diags
+use MOM_boundary_update,       only : call_OBC_register, OBC_register_end, update_OBC_CS
 use MOM_continuity,            only : continuity, continuity_init, continuity_CS
 use MOM_CoriolisAdv,           only : CorAdCalc, CoriolisAdv_init, CoriolisAdv_CS
 use MOM_diabatic_driver,       only : diabatic, diabatic_driver_init, diabatic_CS
@@ -105,6 +106,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 : OBC_registry_type
 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
@@ -121,6 +123,7 @@ module MOM
 use MOM_tracer_registry,       only : lock_tracer_registry, tracer_registry_end
 use MOM_tracer_flow_control,   only : call_tracer_register, tracer_flow_control_CS
 use MOM_tracer_flow_control,   only : tracer_flow_control_init, call_tracer_surface_state
+use MOM_tracer_flow_control,   only : tracer_flow_control_end
 use MOM_transcribe_grid,       only : copy_dyngrid_to_MOM_grid, copy_MOM_grid_to_dyngrid
 use MOM_vert_friction,         only : vertvisc, vertvisc_remnant
 use MOM_vert_friction,         only : vertvisc_limit_vel, vertvisc_init
@@ -390,6 +393,7 @@ module MOM
   type(diagnostics_CS),          pointer :: diagnostics_CSp        => NULL()
   type(diag_to_Z_CS),            pointer :: diag_to_Z_CSp          => NULL()
   type(MOM_restart_CS),          pointer :: restart_CSp            => NULL()
+  type(update_OBC_CS),           pointer :: update_OBC_CSp         => NULL()
   type(ocean_OBC_type),          pointer :: OBC                    => NULL()
   type(sponge_CS),               pointer :: sponge_CSp             => NULL()
   type(ALE_sponge_CS),           pointer :: ALE_sponge_CSp         => NULL()
@@ -2232,6 +2236,9 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in, offline_tracer_mo
   call cpu_clock_begin(id_clock_MOM_init)
   call MOM_initialize_fixed(dG, CS%OBC, param_file, write_geom_files, dirs%output_directory)
   call callTree_waypoint("returned from MOM_initialize_fixed() (initialize_MOM)")
+
+  call call_OBC_register(param_file, CS%update_OBC_CSp, CS%OBC)
+
   call MOM_initialize_coord(GV, param_file, write_geom_files, &
                             dirs%output_directory, CS%tv, dG%max_depth)
   call callTree_waypoint("returned from MOM_initialize_coord() (initialize_MOM)")
@@ -2388,27 +2395,29 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in, offline_tracer_mo
   if (CS%split) then
     allocate(eta(SZI_(G),SZJ_(G))) ; eta(:,:) = 0.0
     if (CS%legacy_split) then
-      call initialize_dyn_legacy_split(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, &
+      call initialize_dyn_legacy_split(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time,   &
                   G, GV, param_file, diag, CS%dyn_legacy_split_CSp, CS%restart_CSp, &
-                  CS%dt, CS%ADp, CS%CDp, MOM_internal_state, CS%VarMix, CS%MEKE,  &
-                  CS%OBC, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, CS%ntrunc)
+                  CS%dt, CS%ADp, CS%CDp, MOM_internal_state, CS%VarMix, CS%MEKE,    &
+                  CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp, CS%visc,  &
+                  dirs, CS%ntrunc)
     else
       call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time,   &
                   G, GV, param_file, diag, CS%dyn_split_RK2_CSp, CS%restart_CSp, &
                   CS%dt, CS%ADp, CS%CDp, MOM_internal_state, CS%VarMix, CS%MEKE, &
-                  CS%OBC, CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, CS%ntrunc)
+                  CS%OBC, CS%update_OBC_CSp, CS%ALE_CSp, CS%set_visc_CSp,        &
+                  CS%visc, dirs, CS%ntrunc)
     endif
   else
     if (CS%use_RK2) then
-      call initialize_dyn_unsplit_RK2(CS%u, CS%v, CS%h, Time, G, GV,       &
-              param_file, diag, CS%dyn_unsplit_RK2_CSp, CS%restart_CSp,    &
-              CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, CS%ALE_CSp, &
-              CS%set_visc_CSp, CS%visc, dirs, CS%ntrunc)
+      call initialize_dyn_unsplit_RK2(CS%u, CS%v, CS%h, Time, G, GV,         &
+              param_file, diag, CS%dyn_unsplit_RK2_CSp, CS%restart_CSp,      &
+              CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, CS%update_OBC_CSp, &
+              CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, CS%ntrunc)
     else
-      call initialize_dyn_unsplit(CS%u, CS%v, CS%h, Time, G, GV,           &
-              param_file, diag, CS%dyn_unsplit_CSp, CS%restart_CSp,        &
-              CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, CS%ALE_CSp, &
-              CS%set_visc_CSp, CS%visc, dirs, CS%ntrunc)
+      call initialize_dyn_unsplit(CS%u, CS%v, CS%h, Time, G, GV,             &
+              param_file, diag, CS%dyn_unsplit_CSp, CS%restart_CSp,          &
+              CS%ADp, CS%CDp, MOM_internal_state, CS%OBC, CS%update_OBC_CSp, &
+              CS%ALE_CSp, CS%set_visc_CSp, CS%visc, dirs, CS%ntrunc)
     endif
   endif
   call callTree_waypoint("dynamics initialized (initialize_MOM)")
@@ -3643,6 +3652,7 @@ subroutine MOM_end(CS)
   call tracer_advect_end(CS%tracer_adv_CSp)
   call tracer_hor_diff_end(CS%tracer_diff_CSp)
   call tracer_registry_end(CS%tracer_Reg)
+  call tracer_flow_control_end(CS%tracer_flow_CSp)
 
   DEALLOC_(CS%uhtr) ; DEALLOC_(CS%vhtr)
   if (CS%split) then ; if (CS%legacy_split) then
@@ -3655,6 +3665,7 @@ subroutine MOM_end(CS)
       call end_dyn_unsplit(CS%dyn_unsplit_CSp)
   endif ; endif
   DEALLOC_(CS%ave_ssh)
+  call OBC_register_end(CS%update_OBC_CSp)
 
   call verticalGridEnd(CS%GV)
   call MOM_grid_end(CS%G)

src/core/MOM_barotropic.F90

@@ -2776,12 +2776,17 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, G, GV, MS, halo, use_BT_cont, Datu, D
         endif
       endif
     endif ; enddo ; enddo
-    if (associated(OBC%ubt_outer)) then ; do j=js,je ; do I=is-1,ie
-      BT_OBC%ubt_outer(I,j) = OBC%ubt_outer(I,j)
-    enddo ; enddo ; endif
-    if (associated(OBC%eta_outer_u)) then ; do j=js,je ; do I=is-1,ie
-      BT_OBC%eta_outer_u(I,j) = OBC%eta_outer_u(I,j)
-    enddo ; enddo ; endif
+    if (OBC%Flather_u_BCs_exist_globally) then
+     do n = 1, OBC%number_of_segments
+        segment => OBC%segment(n)
+        if (segment%is_E_or_W .and. segment%Flather) then
+          do j=segment%HI%jsd,segment%HI%jed ; do I=segment%HI%IsdB,segment%HI%IedB
+            BT_OBC%ubt_outer(I,j) = segment%normal_vel_bt(I,j)
+            BT_OBC%eta_outer_u(I,j) = segment%eta(I,j)
+          enddo ; enddo
+        endif
+      enddo
+    endif
   endif
 
   if (BT_OBC%apply_v_OBCs) then
@@ -2817,12 +2822,17 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, G, GV, MS, halo, use_BT_cont, Datu, D
         endif
       endif
     endif ; enddo ; enddo
-    if (associated(OBC%vbt_outer)) then ; do J=js-1,je ; do i=is,ie
-      BT_OBC%vbt_outer(i,J) = OBC%vbt_outer(i,J)
-    enddo ; enddo ; endif
-    if (associated(OBC%eta_outer_v)) then ; do J=js-1,je ; do i=is,ie
-      BT_OBC%eta_outer_v(i,J) = OBC%eta_outer_v(i,J)
-    enddo ; enddo ; endif
+    if (OBC%Flather_v_BCs_exist_globally) then
+     do n = 1, OBC%number_of_segments
+        segment => OBC%segment(n)
+        if (segment%is_N_or_S .and. segment%Flather) then
+          do J=segment%HI%JsdB,segment%HI%JedB ; do i=segment%HI%isd,segment%HI%ied
+            BT_OBC%vbt_outer(i,J) = segment%normal_vel_bt(i,J)
+            BT_OBC%eta_outer_v(i,J) = segment%eta(i,J)
+          enddo ; enddo
+        endif
+      enddo
+    endif
   endif
 
 end subroutine set_up_BT_OBC

src/core/MOM_boundary_update.F90

@@ -6,25 +6,41 @@ module MOM_boundary_update
 
 use MOM_cpu_clock,             only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE
 use MOM_diag_mediator,         only : 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, log_param
 use MOM_grid,                  only : ocean_grid_type
 use MOM_dyn_horgrid,           only : dyn_horgrid_type
 use MOM_open_boundary,         only : ocean_obc_type, update_OBC_segment_data
+use MOM_open_boundary,         only : OBC_registry_type, file_OBC_CS
+use MOM_open_boundary,         only : register_file_OBC, file_OBC_end
 use MOM_verticalGrid,          only : verticalGrid_type
 use MOM_tracer_registry,       only : add_tracer_OBC_values, tracer_registry_type
 use MOM_variables,             only : thermo_var_ptrs
-use tidal_bay_initialization,  only : tidal_bay_set_OBC_data
-use Kelvin_initialization,     only : Kelvin_set_OBC_data
+use tidal_bay_initialization,  only : tidal_bay_set_OBC_data, register_tidal_bay_OBC
+use tidal_bay_initialization,  only : tidal_bay_OBC_end, tidal_bay_OBC_CS
+use Kelvin_initialization,     only : Kelvin_set_OBC_data, register_Kelvin_OBC
+use Kelvin_initialization,     only : Kelvin_OBC_end, Kelvin_OBC_CS
+use shelfwave_initialization,  only : shelfwave_set_OBC_data, register_shelfwave_OBC
+use shelfwave_initialization,  only : shelfwave_OBC_end, shelfwave_OBC_CS
 
 implicit none ; private
 
 #include <MOM_memory.h>
 
+public call_OBC_register, OBC_register_end
 public update_OBC_data
 
+type, public :: update_OBC_CS ; private
+  logical :: use_files = .false.
+  logical :: use_Kelvin = .false.
+  logical :: use_tidal_bay = .false.
+  logical :: use_shelfwave = .false.
+  type(file_OBC_CS), pointer :: file_OBC_CSp => NULL()
+  type(Kelvin_OBC_CS), pointer :: Kelvin_OBC_CSp => NULL()
+  type(tidal_bay_OBC_CS), pointer :: tidal_bay_OBC_CSp => NULL()
+  type(shelfwave_OBC_CS), pointer :: shelfwave_OBC_CSp => NULL()
+end type update_OBC_CS
+
 integer :: id_clock_pass
 
 character(len=40)  :: mod = "MOM_boundary_update" ! This module's name.
@@ -33,14 +49,60 @@ module MOM_boundary_update
 
 contains
 
+!> The following subroutines and associated definitions provide the
+!! machinery to register and call the subroutines that initialize
+!! open boundary conditions.
+subroutine call_OBC_register(param_file, CS, OBC)
+  type(param_file_type),     intent(in) :: param_file !< Parameter file to parse
+  type(update_OBC_CS),       pointer    :: CS         !< Control structure for OBCs
+  type(ocean_OBC_type),      pointer    :: OBC        !< Open boundary structure
+  character(len=40)  :: mod = "MOM_boundary_update" ! This module's name.
+
+  if (associated(CS)) then
+    call MOM_error(WARNING, "call_OBC_register called with an associated "// &
+                            "control structure.")
+    return
+  else ; allocate(CS) ; endif
+
+  call log_version(param_file, mod, version, "")
+
+  call get_param(param_file, mod, "USE_FILE_OBC", CS%use_files, &
+                 "If true, use external files for the open boundary.", &
+                 default=.false.)
+  call get_param(param_file, mod, "USE_TIDAL_BAY_OBC", CS%use_tidal_bay, &
+                 "If true, use the tidal_bay open boundary.", &
+                 default=.false.)
+  call get_param(param_file, mod, "USE_KELVIN_WAVE_OBC", CS%use_Kelvin, &
+                 "If true, use the Kelvin wave open boundary.", &
+                 default=.false.)
+  call get_param(param_file, mod, "USE_SHELFWAVE_OBC", CS%use_shelfwave, &
+                 "If true, use the shelfwave open boundary.", &
+                 default=.false.)
+
+  if (CS%use_files) CS%use_files = &
+    register_file_OBC(param_file, CS%file_OBC_CSp, &
+               OBC%OBC_Reg)
+  if (CS%use_tidal_bay) CS%use_tidal_bay = &
+    register_tidal_bay_OBC(param_file, CS%tidal_bay_OBC_CSp, &
+               OBC%OBC_Reg)
+  if (CS%use_Kelvin) CS%use_Kelvin = &
+    register_Kelvin_OBC(param_file, CS%Kelvin_OBC_CSp, &
+               OBC%OBC_Reg)
+  if (CS%use_shelfwave) CS%use_shelfwave = &
+    register_shelfwave_OBC(param_file, CS%shelfwave_OBC_CSp, &
+               OBC%OBC_Reg)
+
+end subroutine call_OBC_register
+
 !> Calls appropriate routine to update the open boundary conditions.
-subroutine update_OBC_data(OBC, G, GV, tv, h, Time)
-  type(ocean_grid_type),          intent(in) :: G !< Ocean grid structure
-  type(verticalGrid_type),                   intent(in)    :: GV !<  Ocean vertical grid structure
-  type(thermo_var_ptrs),                     intent(in)    :: tv !< Thermodynamics structure
-  real, dimension(SZI_(G),SZJ_(G),SZK_(G)),  intent(inout) :: h !< layer thickness
-  type(ocean_OBC_type),           pointer    :: OBC !< Open boundary structure
-  type(time_type),                intent(in) :: Time !< Model time
+subroutine update_OBC_data(OBC, G, GV, tv, h, CS, Time)
+  type(ocean_grid_type),                    intent(in) :: G     !< Ocean grid structure
+  type(verticalGrid_type),                  intent(in)    :: GV !< Ocean vertical grid structure
+  type(thermo_var_ptrs),                    intent(in)    :: tv !< Thermodynamics structure
+  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h  !< layer thickness
+  type(ocean_OBC_type),                     pointer    :: OBC   !< Open boundary structure
+  type(update_OBC_CS),                      pointer    :: CS    !< Control structure for OBCs
+  type(time_type),                          intent(in) :: Time  !< Model time
   ! Local variables
   logical :: read_OBC_eta = .false.
   logical :: read_OBC_uv = .false.
@@ -55,16 +117,31 @@ subroutine update_OBC_data(OBC, G, GV, tv, h, Time)
   isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
   IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
 
-  if (OBC%OBC_user_config == "tidal_bay") then
-    call tidal_bay_set_OBC_data(OBC, G, h, Time)
-  elseif (OBC%OBC_user_config == "Kelvin") then
-    call Kelvin_set_OBC_data(OBC, G, h, Time)
-  elseif (OBC%needs_IO_for_data) then
-    call update_OBC_segment_data(G, GV, OBC, tv, h, Time)
-  endif
+! Something here... with CS%file_OBC_CSp?
+! if (CS%use_files) &
+!     call update_OBC_segment_data(G, GV, OBC, tv, h, Time)
+  if (CS%use_tidal_bay) &
+      call tidal_bay_set_OBC_data(OBC, CS%tidal_bay_OBC_CSp, G, h, Time)
+  if (CS%use_Kelvin)  &
+      call Kelvin_set_OBC_data(OBC, CS%Kelvin_OBC_CSp, G, h, Time)
+  if (CS%use_shelfwave) &
+      call shelfwave_set_OBC_data(OBC, CS%shelfwave_OBC_CSp, G, h, Time)
+  if (OBC%needs_IO_for_data)  &
+      call update_OBC_segment_data(G, GV, OBC, tv, h, Time)
 
 end subroutine update_OBC_data
 
+!> Clean up the OBC registry.
+subroutine OBC_register_end(CS)
+  type(update_OBC_CS),       pointer    :: CS !< Control structure for OBCs
+
+  if (CS%use_files) call file_OBC_end(CS%file_OBC_CSp)
+  if (CS%use_tidal_bay) call tidal_bay_OBC_end(CS%tidal_bay_OBC_CSp)
+  if (CS%use_Kelvin) call Kelvin_OBC_end(CS%Kelvin_OBC_CSp)
+
+  if (associated(CS)) deallocate(CS)
+end subroutine OBC_register_end
+
 !> \namespace mom_boundary_update
 !! This module updates the open boundary arrays when time-varying.
 !! It caused a circular dependency with the tidal_bay setup when

src/core/MOM_dynamics_legacy_split.F90

@@ -111,7 +111,7 @@ module MOM_dynamics_legacy_split
 use MOM_MEKE_types, only : MEKE_type
 use MOM_open_boundary, only : ocean_OBC_type
 use MOM_open_boundary, only : radiation_open_bdry_conds
-use MOM_boundary_update, only : update_OBC_data
+use MOM_boundary_update, only : update_OBC_data, update_OBC_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
@@ -245,6 +245,7 @@ module MOM_dynamics_legacy_split
      ! condition type that specifies whether, where, and  what open boundary
      ! conditions are used.  If no open BCs are used, this pointer stays
      ! nullified.  Flather OBCs use open boundary_CS as well.
+  type(update_OBC_CS),    pointer :: update_OBC_CSp => NULL()
   type(tidal_forcing_CS), pointer :: tides_CSp => NULL()
 
 ! This is a copy of the pointer in the top-level control structure.
@@ -493,7 +494,7 @@ subroutine step_MOM_dyn_legacy_split(u, v, h, tv, visc, &
   endif
 
   if (associated(CS%OBC)) then; if (CS%OBC%update_OBC) then
-    call update_OBC_data(CS%OBC, G, GV, tv, h, Time_local)
+    call update_OBC_data(CS%OBC, G, GV, tv, h, CS%update_OBC_CSp, Time_local)
   endif; endif
 
 ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av
@@ -785,7 +786,7 @@ subroutine step_MOM_dyn_legacy_split(u, v, h, tv, visc, &
   endif
 
   if (associated(CS%OBC)) then; if (CS%OBC%update_OBC) then
-    call update_OBC_data(CS%OBC, G, GV, tv, h, Time_local)
+    call update_OBC_data(CS%OBC, G, GV, tv, h, CS%update_OBC_CSp, Time_local)
   endif; endif
 
   if (BT_cont_BT_thick) then
@@ -1206,7 +1207,8 @@ end subroutine register_restarts_dyn_legacy_split
 
 subroutine initialize_dyn_legacy_split(u, v, h, uh, vh, eta, Time, G, GV, param_file, &
                       diag, CS, restart_CS, dt, Accel_diag, Cont_diag, MIS, &
-                      VarMix, MEKE, OBC, ALE_CSp, setVisc_CSp, visc, dirs, ntrunc)
+                      VarMix, MEKE, OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, visc, &
+                      dirs, ntrunc)
   type(ocean_grid_type),                     intent(inout) :: G
   type(verticalGrid_type),                   intent(in)    :: GV
   real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u
@@ -1227,6 +1229,7 @@ subroutine initialize_dyn_legacy_split(u, v, h, uh, vh, eta, Time, G, GV, param_
   type(VarMix_CS),                           pointer       :: VarMix
   type(MEKE_type),                           pointer       :: MEKE
   type(ocean_OBC_type),                      pointer       :: OBC
+  type(update_OBC_CS),                       pointer       :: update_OBC_CSp
   type(ALE_CS),                              pointer       :: ALE_CSp
   type(set_visc_CS),                         pointer       :: setVisc_CSp
   type(vertvisc_type),                       intent(inout) :: visc
@@ -1259,6 +1262,8 @@ subroutine initialize_dyn_legacy_split(u, v, h, uh, vh, eta, Time, G, GV, param_
 !                   the Mesoscale Eddy Kinetic Energy.
 !  (in)      OBC - If open boundary conditions are used, this points to the
 !                  ocean_OBC_type that was set up in MOM_initialization.
+!  (in)      update_OBC_CSp - If open boundary condition updates are used,
+!                  this points to the appropriate control structure.
 !  (in)      ALE_CS - This points to the ALE control structure.
 !  (in)      setVisc_CSp - This points to the set_visc control structure.
 !  (inout)   visc - A structure containing vertical viscosities, bottom drag
@@ -1379,6 +1384,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)) CS%OBC => OBC
+  if (associated(update_OBC_CSp)) CS%update_OBC_CSp => update_OBC_CSp
 
   if (.not. query_initialized(CS%eta,"sfc",restart_CS))  then
     ! Estimate eta based on the layer thicknesses - h.  With the Boussinesq