Reject truncated restart files and incompatible boundary decompositions

src/common/m_boundary_io.fpp

@@ -115,6 +115,7 @@ contains
         character(len=7) :: proc_rank_str
         logical          :: dir_check
         integer          :: nelements
+        integer          :: unit
 
         call s_pack_boundary_condition_buffers(q_prim_vf, q_T_sf)
 
@@ -124,6 +125,10 @@ contains
             if (dir_check .neqv. .true.) then
                 call s_create_directory(trim(file_loc))
             end if
+            ! The files below are per rank, so record the decomposition they were written for
+            open (newunit=unit, FILE=trim(file_loc) // '/decomposition.dat', STATUS='replace')
+            write (unit, '(4(I0,1X))') num_procs, num_procs_x, num_procs_y, num_procs_z
+            close (unit)
         end if
 
         call s_create_mpi_types(bc_type)
@@ -135,6 +140,7 @@ contains
         write (proc_rank_str, '(I7.7)') proc_rank
         file_path = trim(file_loc) // '/bc_' // trim(proc_rank_str) // '.dat'
         call MPI_File_open(MPI_COMM_SELF, trim(file_path), MPI_MODE_CREATE + MPI_MODE_WRONLY, MPI_INFO_NULL, file_id, ierr)
+        call s_check_mpi_file_open(ierr, file_path)
 
         ! Write bc_types
         do dir = 1, num_dims
@@ -207,9 +213,10 @@ contains
     end subroutine s_read_serial_boundary_condition_files
 
     !> Read boundary condition type and buffer data from per-rank parallel files using MPI I/O.
-    subroutine s_read_parallel_boundary_condition_files(bc_type)
+    subroutine s_read_parallel_boundary_condition_files(bc_type, strict)
 
         type(integer_field), dimension(1:num_dims,1:2), intent(inout) :: bc_type
+        logical, intent(in), optional                                 :: strict  !< abort on a decomposition mismatch (default)
         integer                                                       :: dir, loc
         character(len=path_len)                                       :: file_loc, file_path
 
@@ -219,6 +226,7 @@ contains
         character(len=7) :: proc_rank_str
         logical          :: dir_check
         integer          :: nelements
+        logical          :: strict_loc
 
         file_loc = trim(case_dir) // '/restart_data/boundary_conditions'
 
@@ -227,6 +235,9 @@ contains
             if (dir_check .neqv. .true.) then
                 call s_mpi_abort(trim(file_loc) // ' is missing. Exiting.')
             end if
+            strict_loc = .true.
+            if (present(strict)) strict_loc = strict
+            call s_check_bc_decomposition(file_loc, strict_loc)
         end if
 
         call s_create_mpi_types(bc_type)
@@ -238,6 +249,7 @@ contains
         write (proc_rank_str, '(I7.7)') proc_rank
         file_path = trim(file_loc) // '/bc_' // trim(proc_rank_str) // '.dat'
         call MPI_File_open(MPI_COMM_SELF, trim(file_path), MPI_MODE_RDONLY, MPI_INFO_NULL, file_id, ierr)
+        call s_check_mpi_file_open(ierr, file_path)
 
         ! Read bc_types
         do dir = 1, num_dims
@@ -267,6 +279,52 @@ contains
 
     end subroutine s_read_parallel_boundary_condition_files
 
+    !> Check that the per-rank boundary files in file_loc were written for this run's decomposition: abort if strict, else warn.
+    !! They are read by rank index, so on another decomposition each rank would silently read another rank's boundary slab. Files
+    !! written before decomposition.dat existed are not checked.
+    impure subroutine s_check_bc_decomposition(file_loc, strict)
+
+        character(len=*), intent(in) :: file_loc
+        logical, intent(in)          :: strict
+        integer                      :: decomp(4)
+        integer                      :: unit, ios
+        logical                      :: file_exist
+        character(len=64)            :: written, running
+
+        inquire (FILE=trim(file_loc) // '/decomposition.dat', EXIST=file_exist)
+        if (.not. file_exist) return
+
+        open (newunit=unit, FILE=trim(file_loc) // '/decomposition.dat', STATUS='old', ACTION='read', iostat=ios)
+        if (ios == 0) then
+            read (unit, *, iostat=ios) decomp
+            close (unit)
+        end if
+        if (ios /= 0) then
+            if (strict) then
+                call s_mpi_abort(trim(file_loc) // '/decomposition.dat is unreadable. Exiting.')
+            else
+                print '(A)', 'WARNING: ' // trim(file_loc) // '/decomposition.dat is unreadable; rank count not checked.'
+            end if
+            return
+        end if
+
+        if (any(decomp /= [num_procs, num_procs_x, num_procs_y, num_procs_z])) then
+            write (written, '(I0," ranks (",I0,"x",I0,"x",I0,")")') decomp
+            write (running, '(I0," ranks (",I0,"x",I0,"x",I0,")")') num_procs, num_procs_x, num_procs_y, num_procs_z
+            if (strict) then
+                call s_mpi_abort(trim(file_loc) // ' was written for ' // trim(written) // ' but this run uses ' // trim(running) &
+                                 & // '. These per-rank boundary files only work on the decomposition that ' &
+                                 & // 'wrote them: run on that rank count, or rerun pre_process on this one.')
+            else
+                print '(A)', &
+                                                 & 'WARNING: ' // trim(file_loc) // ' was written for ' // trim(written) &
+                                                 & // ' but this run uses ' // trim(running) &
+                                                 & // '; boundary ghost values will be wrong. Use the pre_process rank count.'
+            end if
+        end if
+
+    end subroutine s_check_bc_decomposition
+
     !> Pack primitive variable boundary slices into bc_buffers arrays for serialization.
     subroutine s_pack_boundary_condition_buffers(q_prim_vf, q_T_sf)
 

src/post_process/m_data_input.f90

@@ -388,7 +388,7 @@ impure subroutine s_read_parallel_data_files(t_step)
         deallocate (x_cb_glb, y_cb_glb, z_cb_glb)
 
         if (bc_io) then
-            call s_read_parallel_boundary_condition_files(bc_type)
+            call s_read_parallel_boundary_condition_files(bc_type, strict=.false.)
         else
             call s_assign_default_bc_type(bc_type)
         end if

src/simulation/m_start_up.fpp

@@ -283,6 +283,7 @@ contains
         logical                              :: file_exist
         character(len=10)                    :: t_step_start_string
         integer                              :: i, j
+        integer(KIND=MPI_OFFSET_KIND)        :: nvars_MOK  !< variables read per cell
 
         ! Downsampled data variables
         integer :: m_ds, n_ds, p_ds
@@ -355,6 +356,9 @@ contains
             end if
         end if
 
+        nvars_MOK = int(sys_size, MPI_OFFSET_KIND)
+        if ((bubbles_euler .or. hypoelasticity) .and. qbmm .and. .not. polytropic) nvars_MOK = nvars_MOK + 2*nb*nnode
+
         if (file_per_process) then
             if (cfl_dt) then
                 call s_int_to_str(n_start, t_step_start_string)
@@ -392,6 +396,8 @@ contains
                     n_glb_read = n_glb + 1
                     p_glb_read = p_glb + 1
                 end if
+                call s_check_restart_file_size(ifile, file_loc, int(data_size, MPI_OFFSET_KIND)*int(storage_size(0._stp)/8, &
+                                               & MPI_OFFSET_KIND)*nvars_MOK)
 
                 m_MOK = int(m_glb_read + 1, MPI_OFFSET_KIND)
                 n_MOK = int(m_glb_read + 1, MPI_OFFSET_KIND)
@@ -462,6 +468,7 @@ contains
                 p_MOK = int(p_glb + 1, MPI_OFFSET_KIND)
                 WP_MOK = int(storage_size(0._stp)/8, MPI_OFFSET_KIND)
                 MOK = int(1._wp, MPI_OFFSET_KIND)
+                call s_check_restart_file_size(ifile, file_loc, m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*nvars_MOK)
 
                 if (bubbles_euler .or. hypoelasticity) then
                     do i = 1, sys_size
@@ -511,6 +518,29 @@ contains
 
     end subroutine s_read_parallel_data_files
 
+#ifdef MFC_MPI
+    !> Abort if an open restart file holds fewer bytes than are about to be read from it, as a job killed while writing it leaves.
+    !! MPI reads past the end return short without an error, so the missing tail would come back as garbage.
+    impure subroutine s_check_restart_file_size(ifile, file_loc, expected_bytes)
+
+        integer, intent(in)                       :: ifile
+        character(len=*), intent(in)              :: file_loc
+        integer(KIND=MPI_OFFSET_KIND), intent(in) :: expected_bytes
+        integer(KIND=MPI_OFFSET_KIND)             :: file_bytes
+        integer                                   :: ierr
+        character(len=64)                         :: sizes
+
+        call MPI_FILE_GET_SIZE(ifile, file_bytes, ierr)
+        if (ierr /= MPI_SUCCESS) call s_mpi_abort('MPI_FILE_GET_SIZE failed on ' // trim(file_loc) // '. Exiting.')
+        if (file_bytes < expected_bytes) then
+            write (sizes, '(I0," bytes but ",I0)') file_bytes, expected_bytes
+            call s_mpi_abort('Restart file ' // trim(file_loc) // ' holds ' // trim(sizes) // ' are expected. It is ' &
+                             & // 'truncated, e.g. by a job killed while writing it; restart from an earlier step.')
+        end if
+
+    end subroutine s_check_restart_file_size
+#endif
+
     !> Initialize internal-energy equations from phase mass, mixture momentum, and total energy
     subroutine s_initialize_internal_energy_equations(v_vf)