Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
60 changes: 59 additions & 1 deletion src/common/m_boundary_io.fpp
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand All @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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

Expand All @@ -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'

Expand All @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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)

Expand Down
2 changes: 1 addition & 1 deletion src/post_process/m_data_input.f90
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading