+Add a restart registry lock & fix OBC call order

Added code to lock the restart registry once all registration should have occurred or if the restart has been read, along with a new public interface, restart_registry_lock, to allow this lock to be set or unset. All calls to register restart fields now check the state of this lock and issue a fatal error if the registry is locked. This PR addresses MOM6 issue #1214. In the process of adding this restart lock, the new error messages revealed that some of the restart registration calls related to some types of open boundary conditions were not happening early enough. To avoid this, a new interface, register_DOME_OBC, was added to the DOME_initialization module and is being called from call_OBC_register, and a number of the OBC-related calls during the initialization were collected in the same (appropriate) place. Some OBC error messages were also corrected. All answers are bitwise identical, but there are two new public interfaces and the order of some OBC-related entries in the MOM_parameter_doc calls changed.
mom-ocean · Jul 8, 2021 · afe75e8 · nikizadehgfdl · Aug 3, 2021 · afe75e8
1 parent 52f906c
commit afe75e8
Show file tree

Hide file tree

Showing 5 changed files with 191 additions and 68 deletions.
diff --git a/src/core/MOM.F90 b/src/core/MOM.F90
@@ -41,7 +41,7 @@ module MOM
 use MOM_io,                   only : slasher, file_exists, MOM_read_data
 use MOM_obsolete_params,      only : find_obsolete_params
 use MOM_restart,              only : register_restart_field, register_restart_pair
-use MOM_restart,              only : query_initialized, save_restart
+use MOM_restart,              only : query_initialized, save_restart, restart_registry_lock
 use MOM_restart,              only : restart_init, is_new_run, determine_is_new_run, MOM_restart_CS
 use MOM_spatial_means,        only : global_mass_integral
 use MOM_time_manager,         only : time_type, real_to_time, time_type_to_real, operator(+)
@@ -2152,8 +2152,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
     if (associated(OBC_in)) then
       ! TODO: General OBC index rotations is not yet supported.
       if (modulo(turns, 4) /= 1) &
-        call MOM_error(FATAL, "OBC index rotation of 180 and 270 degrees is " &
-          // "not yet unsupported.")
+        call MOM_error(FATAL, "OBC index rotation of 180 and 270 degrees is not yet supported.")
       allocate(CS%OBC)
       call rotate_OBC_config(OBC_in, dG_in, CS%OBC, dG, turns)
     endif
@@ -2174,8 +2173,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
 
   call MOM_timing_init(CS)
 
-  if (associated(CS%OBC)) call call_OBC_register(param_file, CS%update_OBC_CSp, US, CS%OBC)
-
   call tracer_registry_init(param_file, CS%tracer_Reg)
 
   ! Allocate and initialize space for the primary time-varying MOM variables.
@@ -2229,21 +2226,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
                            flux_scale=conv2salt, convergence_units='kg m-2 s-1', &
                            convergence_scale=0.001*GV%H_to_kg_m2, CMOR_tendprefix="osalt", diag_form=2)
     endif
-    ! NOTE: register_temp_salt_segments includes allocation of tracer fields
-    !   along segments.  Bit reproducibility requires that MOM_initialize_state
-    !   be called on the input index map, so we must setup both OBC and OBC_in.
-    !
-    ! XXX: This call on OBC_in allocates the tracer fields on the unrotated
-    !   grid, but also incorrectly stores a pointer to a tracer_type for the
-    !   rotated registry (e.g. segment%tr_reg%Tr(n)%Tr) from CS%tracer_reg.
-    !
-    !   While incorrect and potentially dangerous, it does not seem that this
-    !   pointer is used during initialization, so we leave it for now.
-    if (CS%rotate_index .and. associated(OBC_in)) &
-      call register_temp_salt_segments(GV, OBC_in, CS%tracer_Reg, param_file)
-    if (associated(CS%OBC)) &
-      call register_temp_salt_segments(GV, CS%OBC, CS%tracer_Reg, param_file)
   endif
+
   if (use_frazil) then
     allocate(CS%tv%frazil(isd:ied,jsd:jed)) ; CS%tv%frazil(:,:) = 0.0
   endif
@@ -2336,11 +2320,38 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
   call mixedlayer_restrat_register_restarts(dG%HI, param_file, &
            CS%mixedlayer_restrat_CSp, restart_CSp)
 
-  if (associated(CS%OBC)) &
+  if (CS%rotate_index .and. associated(OBC_in) .and. use_temperature) then
+    ! NOTE: register_temp_salt_segments includes allocation of tracer fields
+    !   along segments.  Bit reproducibility requires that MOM_initialize_state
+    !   be called on the input index map, so we must setup both OBC and OBC_in.
+    !
+    ! XXX: This call on OBC_in allocates the tracer fields on the unrotated
+    !   grid, but also incorrectly stores a pointer to a tracer_type for the
+    !   rotated registry (e.g. segment%tr_reg%Tr(n)%Tr) from CS%tracer_reg.
+    !
+    !   While incorrect and potentially dangerous, it does not seem that this
+    !   pointer is used during initialization, so we leave it for now.
+    call register_temp_salt_segments(GV, OBC_in, CS%tracer_Reg, param_file)
+  endif
+
+  if (associated(CS%OBC)) then
+    ! Set up remaining information about open boundary conditions that is needed for OBCs.
+    call call_OBC_register(param_file, CS%update_OBC_CSp, US, CS%OBC, CS%tracer_Reg)
+  !### Package specific changes to OBCs need to go here?
+
+    ! This is the equivalent to 2 calls to register_segment_tracer (per segment), which
+    ! could occur with the call to update_OBC_data or after the main initialization.
+    if (use_temperature) &
+      call register_temp_salt_segments(GV, CS%OBC, CS%tracer_Reg, param_file)
+
+    ! This needs the number of tracers and to have called any code that sets whether
+    ! reservoirs are used.
     call open_boundary_register_restarts(dg%HI, GV, CS%OBC, CS%tracer_Reg, &
                           param_file, restart_CSp, use_temperature)
+  endif
 
   call callTree_waypoint("restart registration complete (initialize_MOM)")
+  call restart_registry_lock(restart_CSp)
 
   !   Shift from using the temporary dynamic grid type to using the final
   ! (potentially static) ocean-specific grid type.
@@ -2438,7 +2449,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
         turns, CS%u, CS%v, CS%h, CS%T, CS%S)
 
     if (associated(sponge_in_CSp)) then
-      ! TODO: Implementation and testing of non-ALE spong rotation
+      ! TODO: Implementation and testing of non-ALE sponge rotation
       call MOM_error(FATAL, "Index rotation of non-ALE sponge is not yet implemented.")
     endif
 
@@ -2478,19 +2489,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
   endif
 
   if (use_ice_shelf .and. CS%debug) &
-    call hchksum(CS%frac_shelf_h, "MOM:frac_shelf_h", G%HI, &
-        haloshift=0)
+    call hchksum(CS%frac_shelf_h, "MOM:frac_shelf_h", G%HI, haloshift=0)
 
   call cpu_clock_end(id_clock_MOM_init)
   call callTree_waypoint("returned from MOM_initialize_state() (initialize_MOM)")
 
-! ! Need this after MOM_initialize_state for DOME OBC stuff.
-! if (associated(CS%OBC)) &
-!   call open_boundary_register_restarts(G%HI, GV, CS%OBC, CS%tracer_Reg, &
-!                         param_file, restart_CSp, use_temperature)
-
-! call callTree_waypoint("restart registration complete (initialize_MOM)")
-
   ! From this point, there may be pointers being set, so the final grid type
   ! that will persist throughout the run has to be used.
 
@@ -2845,6 +2848,7 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp)
   if (CS%write_IC) then
     allocate(restart_CSp_tmp)
     restart_CSp_tmp = restart_CSp
+    call restart_registry_lock(restart_CSp_tmp, unlocked=.true.)
     allocate(z_interface(SZI_(G),SZJ_(G),SZK_(GV)+1))
     call find_eta(CS%h, CS%tv, G, GV, US, z_interface, eta_to_m=1.0)
     call register_restart_field(z_interface, "eta", .true., restart_CSp_tmp, &

diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90
@@ -17,6 +17,7 @@ module MOM_boundary_update
 use MOM_tracer_registry,       only : tracer_registry_type
 use MOM_variables,             only : thermo_var_ptrs
 use MOM_verticalGrid,          only : verticalGrid_type
+use DOME_initialization,       only : register_DOME_OBC
 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
@@ -58,13 +59,15 @@ module MOM_boundary_update
 !> 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, US, OBC)
+subroutine call_OBC_register(param_file, CS, US, OBC, tr_Reg)
   type(param_file_type),     intent(in) :: param_file !< Parameter file to parse
   type(update_OBC_CS),       pointer    :: CS         !< Control structure for OBCs
   type(unit_scale_type),     intent(in) :: US         !< A dimensional unit scaling type
   type(ocean_OBC_type),      pointer    :: OBC        !< Open boundary structure
+  type(tracer_registry_type), pointer   :: tr_Reg     !< Tracer registry.
 
   ! Local variables
+  character(len=200) :: config
   character(len=40)  :: mdl = "MOM_boundary_update" ! This module's name.
   ! This include declares and sets the variable "version".
 # include "version_variable.h"
@@ -91,10 +94,29 @@ subroutine call_OBC_register(param_file, CS, US, OBC)
   call get_param(param_file, mdl, "USE_DYED_CHANNEL_OBC", CS%use_dyed_channel, &
                  "If true, use the dyed channel open boundary.", &
                  default=.false.)
+  call get_param(param_file, mdl, "OBC_USER_CONFIG", config, &
+               "A string that sets how the user code is invoked to set open boundary data: \n"//&
+               "   DOME - specified inflow on northern boundary\n"//&
+               "   dyed_channel - supercritical with dye on the inflow boundary\n"//&
+               "   dyed_obcs - circle_obcs with dyes on the open boundaries\n"//&
+               "   Kelvin - barotropic Kelvin wave forcing on the western boundary\n"//&
+               "   shelfwave - Flather with shelf wave forcing on western boundary\n"//&
+               "   supercritical - now only needed here for the allocations\n"//&
+               "   tidal_bay - Flather with tidal forcing on eastern boundary\n"//&
+               "   USER - user specified", default="none", do_not_log=.true.)
 
   if (CS%use_files) CS%use_files = &
     register_file_OBC(param_file, CS%file_OBC_CSp, US, &
                OBC%OBC_Reg)
+
+  if (trim(config) == "DOME") then
+    call register_DOME_OBC(param_file, US, OBC, tr_Reg)
+!  elseif (trim(config) == "tidal_bay") then
+!  elseif (trim(config) == "Kelvin") then
+!  elseif (trim(config) == "shelfwave") then
+!  elseif (trim(config) == "dyed_channel") then
+  endif
+
   if (CS%use_tidal_bay) CS%use_tidal_bay = &
     register_tidal_bay_OBC(param_file, CS%tidal_bay_OBC_CSp, US, &
                OBC%OBC_Reg)
@@ -150,7 +172,7 @@ 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
+!! It caused a circular dependency with the tidal_bay and other setups when in
 !! MOM_open_boundary.
 !!
 !! A small fragment of the grid is shown below:

diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90
@@ -342,8 +342,6 @@ module MOM_open_boundary
 integer :: id_clock_pass !< A CPU time clock
 
 character(len=40)  :: mdl = "MOM_open_boundary" !< This module's name.
-! This include declares and sets the variable "version".
-#include "version_variable.h"
 
 contains
 
@@ -359,6 +357,7 @@ subroutine open_boundary_config(G, US, param_file, OBC)
   type(unit_scale_type),   intent(in)    :: US  !< A dimensional unit scaling type
   type(param_file_type),   intent(in)    :: param_file !< Parameter file handle
   type(ocean_OBC_type),    pointer       :: OBC !< Open boundary control structure
+
   ! Local variables
   integer :: l ! For looping over segments
   logical :: debug_OBC, debug, mask_outside, reentrant_x, reentrant_y
@@ -370,6 +369,9 @@ subroutine open_boundary_config(G, US, param_file, OBC)
   logical :: answers_2018, default_2018_answers
   logical :: check_reconstruction, check_remapping, force_bounds_in_subcell
   character(len=32)  :: remappingScheme
+! This include declares and sets the variable "version".
+# include "version_variable.h"
+
   allocate(OBC)
 
   call get_param(param_file, mdl, "OBC_NUMBER_OF_SEGMENTS", OBC%number_of_segments, &
@@ -4433,8 +4435,8 @@ subroutine register_OBC(name, param_file, Reg)
   Reg%OB(nobc)%name = name
 
   if (Reg%locked) call MOM_error(FATAL, &
-      "MOM register_tracer was called for variable "//trim(Reg%OB(nobc)%name)//&
-      " with a locked tracer registry.")
+      "MOM register_OBC was called for OBC "//trim(Reg%OB(nobc)%name)//&
+      " with a locked OBC registry.")
 
 end subroutine register_OBC
 
@@ -4445,15 +4447,15 @@ subroutine OBC_registry_init(param_file, Reg)
 
   integer, save :: init_calls = 0
 
-#include "version_variable.h"
+# include "version_variable.h"
   character(len=40)  :: mdl = "MOM_open_boundary" ! This module's name.
   character(len=256) :: mesg    ! Message for error messages.
 
   if (.not.associated(Reg)) then ; allocate(Reg)
   else ; return ; endif
 
   ! Read all relevant parameters and write them to the model log.
-! call log_version(param_file, mdl,s version, "")
+! call log_version(param_file, mdl, version, "")
 
   init_calls = init_calls + 1
   if (init_calls > 1) then
@@ -4503,7 +4505,7 @@ subroutine segment_tracer_registry_init(param_file, segment)
   integer, save :: init_calls = 0
 
 ! This include declares and sets the variable "version".
-#include "version_variable.h"
+# include "version_variable.h"
   character(len=40)  :: mdl = "segment_tracer_registry_init" ! This routine's name.
   character(len=256) :: mesg    ! Message for error messages.
 
@@ -4527,6 +4529,8 @@ subroutine segment_tracer_registry_init(param_file, segment)
 
 end subroutine segment_tracer_registry_init
 
+!> Register a tracer array that is active on an OBC segment, potentially also specifing how the
+!! tracer inflow values are specified.
 subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, &
                                    OBC_scalar, OBC_array)
   type(verticalGrid_type), intent(in)   :: GV         !< ocean vertical grid structure
@@ -4537,7 +4541,7 @@ subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, &
                                                       !! but it also means that any updates to this
                                                       !! structure in the calling module will be
                                                       !! available subsequently to the tracer registry.
-  type(param_file_type), intent(in)     :: param_file !< file to parse for  model parameter values
+  type(param_file_type), intent(in)     :: param_file !< file to parse for model parameter values
   type(OBC_segment_type), intent(inout) :: segment    !< current segment data structure
   real, optional, intent(in)            :: OBC_scalar !< If present, use scalar value for segment tracer
                                                       !! inflow concentration.
@@ -4555,8 +4559,8 @@ subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, &
 
   if (segment%tr_Reg%ntseg>=MAX_FIELDS_) then
     write(mesg,'("Increase MAX_FIELDS_ in MOM_memory.h to at least ",I3," to allow for &
-        &all the tracers being registered via register_tracer.")') segment%tr_Reg%ntseg+1
-    call MOM_error(FATAL,"MOM register_tracer: "//mesg)
+        &all the tracers being registered via register_segment_tracer.")') segment%tr_Reg%ntseg+1
+    call MOM_error(FATAL,"MOM register_segment_tracer: "//mesg)
   endif
   segment%tr_Reg%ntseg = segment%tr_Reg%ntseg + 1
   ntseg     = segment%tr_Reg%ntseg
@@ -4570,7 +4574,7 @@ subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, &
   segment%tr_Reg%Tr(ntseg)%name = tr_ptr%name
 
   if (segment%tr_Reg%locked) call MOM_error(FATAL, &
-      "MOM register_tracer was called for variable "//trim(segment%tr_Reg%Tr(ntseg)%name)//&
+      "MOM register_segment_tracer was called for variable "//trim(segment%tr_Reg%Tr(ntseg)%name)//&
       " with a locked tracer registry.")
 
   if (present(OBC_scalar)) segment%tr_Reg%Tr(ntseg)%OBC_inflow_conc = OBC_scalar ! initialize tracer value later