diff --git a/components/lfric-xios/source/lfric_xios_context_mod.f90 b/components/lfric-xios/source/lfric_xios_context_mod.f90 index 9c456cadb..c349c3a5b 100644 --- a/components/lfric-xios/source/lfric_xios_context_mod.f90 +++ b/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) diff --git a/components/lfric-xios/source/lfric_xios_file_mod.f90 b/components/lfric-xios/source/lfric_xios_file_mod.f90 index 0a51acf64..651b36fa0 100644 --- a/components/lfric-xios/source/lfric_xios_file_mod.f90 +++ b/components/lfric-xios/source/lfric_xios_file_mod.f90 @@ -427,10 +427,11 @@ subroutine register_with_context(self) call xios_add_child(self%handle, file_fields, self%field_group_id) end if - ! Set up read_access attribute for fields in file - if (self%mode_is_read()) then - call xios_set_attr(file_fields, read_access=.true.) - end if + ! Set mpi-io metadata read for file & read_access attribute for fields in file + if (self%mode_is_read()) then + call xios_set_attr(self%handle, read_metadata_par=.true.) + call xios_set_attr(file_fields, read_access=.true.) + end if ! Set up fields in file if (allocated(self%fields)) then diff --git a/infrastructure/source/utilities/lfric_mpi_mod.F90 b/infrastructure/source/utilities/lfric_mpi_mod.F90 index ec3f211f6..67235b11b 100644 --- a/infrastructure/source/utilities/lfric_mpi_mod.F90 +++ b/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