mpi barrier to synchronise xios_close_context_definition for MPI-IO coordination

Author: mo-marqh

components/lfric-xios/source/lfric_xios_context_mod.f90

@@ -51,6 +51,7 @@ module lfric_xios_context_mod
     type(xios_context)     :: handle
     type(linked_list_type) :: filelist
     integer(i_def)         :: context_clock_step = 1_i_def
+    type(lfric_comm_type)  :: communicator
 
     logical :: uses_timer = .false.
     logical :: xios_context_initialised = .false.
@@ -147,6 +148,8 @@ subroutine initialise_xios_context( this,                  &
       zero_start = .false.
     end if
 
+    this%communicator = communicator
+
     call xios_context_initialize( this%get_context_name(), &
                                   communicator%get_comm_mpi_val() )
     call xios_get_handle( this%get_context_name(), this%handle )
@@ -191,6 +194,8 @@ subroutine close_context_definition(this)
     ! can be defined after this point
     if ( LPROF ) call start_timing(timing_id, 'xios.close_context_definition')
     call log_event('XIOS context definition closing', log_level_debug)
+    ! Set an MPI barrier to support MPI-IO metadata interaction synchronisation.
+    call this%communicator%barrier_mpi()
     call xios_close_context_definition()
     if ( LPROF ) call stop_timing(timing_id, 'xios.close_context_definition')
     call log_event('XIOS context definition closed', log_level_debug)

infrastructure/source/utilities/lfric_mpi_mod.F90

@@ -23,7 +23,7 @@ module lfric_mpi_mod
                  mpi_character,                                         &
                  mpi_init, mpi_finalize,                                &
                  mpi_comm_dup, mpi_comm_free,                           &
-                 mpi_comm_size, mpi_comm_rank
+                 mpi_comm_size, mpi_comm_rank, mpi_barrier
 #else
   use mpi_f08, only: mpi_comm, mpi_datatype, mpi_comm_world,                &
                      mpi_sum, mpi_min, mpi_max, mpi_success,                &
@@ -32,7 +32,7 @@ module lfric_mpi_mod
                      mpi_character,                                         &
                      mpi_init, mpi_finalize,                                &
                      mpi_comm_dup, mpi_comm_free,                           &
-                     mpi_comm_size, mpi_comm_rank
+                     mpi_comm_size, mpi_comm_rank, mpi_barrier
 #endif
 ! The above use statement should include mpi_bcast, mpi_allreduce and
 ! mpi_allgather, but an apparent bug in Cray mpich causes a failure if
@@ -150,6 +150,7 @@ module lfric_mpi_mod
   contains
     procedure, public :: get_comm_mpi_val
     procedure, public :: set_comm_mpi_val
+    procedure, public :: barrier_mpi
   end type
 
 #ifdef NO_MPI
@@ -1526,6 +1527,23 @@ subroutine set_comm_mpi_val(self, comm)
 #endif
   end subroutine set_comm_mpi_val
 
+  !> Call an MPI Barrier, synchronising ranks in the communicator.
+  subroutine barrier_mpi(self)
+    implicit none
+    class(lfric_comm_type), intent(in)  :: self
+    integer :: ierr
+
+#ifdef NO_MPI
+    ! null operation, barrier is non-existant
+    ierr = 0
+#else
+    call mpi_barrier(self%comm, ierr)
+    if (ierr /= mpi_success) then
+      call log_event('Unable to progress through MPI barrier', LOG_LEVEL_ERROR )
+    end if
+#endif
+  end subroutine barrier_mpi
+
   !> Returns the integer datatype
   !>
   !> @return datatype The integer component of the datatype