From 14fbd9ac35d6947abc06e343a57d5a070240a703 Mon Sep 17 00:00:00 2001 From: Yves Vollmeier Date: Thu, 15 Oct 2026 09:39:25 +0200 Subject: [PATCH 1/2] MPI-IO: pass field sections, not pointers, so the interior is packed --- src/post_process/m_data_input.f90 | 6 +++--- src/pre_process/m_data_output.fpp | 12 ++++++------ src/pre_process/m_start_up.fpp | 4 ++-- src/simulation/m_data_output.fpp | 16 ++++++++-------- src/simulation/m_start_up.fpp | 12 ++++++------ 5 files changed, 25 insertions(+), 25 deletions(-) diff --git a/src/post_process/m_data_input.f90 b/src/post_process/m_data_input.f90 index a616aa1b1..c9eafab20 100644 --- a/src/post_process/m_data_input.f90 +++ b/src/post_process/m_data_input.f90 @@ -448,12 +448,12 @@ impure subroutine s_read_parallel_conservative_data(t_step, m_MOK, n_MOK, p_MOK, if (bubbles_euler .or. hypoelasticity .or. mhd) then do i = 1, sys_size var_MOK = int(i, MPI_OFFSET_KIND) - call MPI_FILE_READ_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_READ_ALL(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do else do i = 1, sys_size var_MOK = int(i, MPI_OFFSET_KIND) - call MPI_FILE_READ_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_READ_ALL(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do end if @@ -487,7 +487,7 @@ impure subroutine s_read_parallel_conservative_data(t_step, m_MOK, n_MOK, p_MOK, disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), 'native', mpi_info_int, ierr) - call MPI_FILE_READ_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_READ_ALL(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do call s_mpi_barrier() diff --git a/src/pre_process/m_data_output.fpp b/src/pre_process/m_data_output.fpp index 25b93bfab..98e8c187e 100644 --- a/src/pre_process/m_data_output.fpp +++ b/src/pre_process/m_data_output.fpp @@ -494,13 +494,13 @@ contains do i = 1, sys_size var_MOK = int(i, MPI_OFFSET_KIND) - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do if (qbmm .and. .not. polytropic) then do i = sys_size + 1, sys_size + 2*nb*nnode var_MOK = int(i, MPI_OFFSET_KIND) - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do end if else @@ -514,7 +514,7 @@ contains do i = 1, sys_size var_MOK = int(i, MPI_OFFSET_KIND) - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do end if end if @@ -571,7 +571,7 @@ contains disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) call MPI_FILE_SET_VIEW(ifile, disp, mpi_io_p, MPI_IO_DATA%view(i), 'native', mpi_info_int, ierr) - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do if (qbmm .and. .not. polytropic) then do i = sys_size + 1, sys_size + 2*nb*nnode @@ -580,7 +580,7 @@ contains disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) call MPI_FILE_SET_VIEW(ifile, disp, mpi_io_p, MPI_IO_DATA%view(i), 'native', mpi_info_int, ierr) - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do end if else @@ -590,7 +590,7 @@ contains disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) call MPI_FILE_SET_VIEW(ifile, disp, mpi_io_p, MPI_IO_DATA%view(i), 'native', mpi_info_int, ierr) - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do end if diff --git a/src/pre_process/m_start_up.fpp b/src/pre_process/m_start_up.fpp index 51aac191a..58b2f382b 100644 --- a/src/pre_process/m_start_up.fpp +++ b/src/pre_process/m_start_up.fpp @@ -470,7 +470,7 @@ contains disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), 'native', mpi_info_int, ierr) - call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf, data_size, mpi_p, status, ierr) + call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size, mpi_p, status, ierr) end do if (qbmm .and. .not. polytropic) then @@ -481,7 +481,7 @@ contains disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), 'native', mpi_info_int, ierr) - call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf, data_size, mpi_p, status, ierr) + call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size, mpi_p, status, ierr) end do end if diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index 112ea52a2..a4107af61 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -580,7 +580,7 @@ contains if ((prim_vars_wrt .or. (n == 0 .and. p == 0)) .and. (.not. igr)) then call s_convert_conservative_to_primitive_variables(q_cons_vf, q_T_sf, q_prim_vf, idwint) do i = 1, sys_size - $:GPU_UPDATE(host='[q_prim_vf(i)%sf(:, :, :)]') + $:GPU_UPDATE(host='[q_prim_vf(i)%sf(:,:,:)]') end do ! q_prim_vf(eqn_idx%bub%beg) stores the value of nb needed in riemann solvers, so replace with true primitive value ! (=1._wp) @@ -926,13 +926,13 @@ contains do i = 1, sys_size var_MOK = int(i, MPI_OFFSET_KIND) - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do if (qbmm .and. .not. polytropic) then do i = sys_size + 1, sys_size + 2*nb*nnode var_MOK = int(i, MPI_OFFSET_KIND) - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do end if else @@ -946,7 +946,7 @@ contains do i = 1, sys_size ! TODO: check if sys_size is correct var_MOK = int(i, MPI_OFFSET_KIND) - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do end if end if @@ -992,7 +992,7 @@ contains disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), 'native', mpi_info_int, ierr) - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do if (qbmm .and. .not. polytropic) then do i = sys_size + 1, sys_size + 2*nb*nnode @@ -1001,7 +1001,7 @@ contains disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), 'native', mpi_info_int, ierr) - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do end if else @@ -1011,7 +1011,7 @@ contains disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(i), 'native', mpi_info_int, ierr) - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do end if @@ -1021,7 +1021,7 @@ contains disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(sys_size + 1), 'native', mpi_info_int, ierr) - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(sys_size + 1)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(sys_size + 1)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end if call MPI_FILE_CLOSE(ifile, ierr) diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp index c4aa060a9..98ab2db5d 100644 --- a/src/simulation/m_start_up.fpp +++ b/src/simulation/m_start_up.fpp @@ -409,14 +409,14 @@ contains do i = 1, sys_size var_MOK = int(i, MPI_OFFSET_KIND) - call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do ! Read pb and mv for non-polytropic qbmm if (qbmm .and. .not. polytropic) then do i = sys_size + 1, sys_size + 2*nb*nnode var_MOK = int(i, MPI_OFFSET_KIND) - call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do end if else @@ -430,7 +430,7 @@ contains do i = 1, sys_size var_MOK = int(i, MPI_OFFSET_KIND) - call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do end if end if @@ -476,7 +476,7 @@ contains disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) call MPI_FILE_SET_VIEW(ifile, disp, mpi_io_p, MPI_IO_DATA%view(i), 'native', mpi_info_int, ierr) - call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do ! Read pb and mv for non-polytropic qbmm if (qbmm .and. .not. polytropic) then @@ -485,7 +485,7 @@ contains disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) call MPI_FILE_SET_VIEW(ifile, disp, mpi_io_p, MPI_IO_DATA%view(i), 'native', mpi_info_int, ierr) - call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_READ(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do end if else @@ -495,7 +495,7 @@ contains disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) call MPI_FILE_SET_VIEW(ifile, disp, mpi_io_p, MPI_IO_DATA%view(i), 'native', mpi_info_int, ierr) - call MPI_FILE_READ_ALL(ifile, MPI_IO_DATA%var(i)%sf, data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_READ_ALL(ifile, MPI_IO_DATA%var(i)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) end do end if From 9e6ef09aa7ad177becdcc268db6804a61b86b231 Mon Sep 17 00:00:00 2001 From: Yves Vollmeier Date: Thu, 15 Oct 2026 10:01:47 +0200 Subject: [PATCH 2/2] Format: wrap the long MPI-IO call, restore the GPU_UPDATE spacing ./mfc.sh format, as the lint gate requires: one MPI_FILE_WRITE_ALL line exceeded the line limit with the section, and the original patch had dropped the spaces in an unrelated GPU_UPDATE line. Co-Authored-By: Claude Opus 5.5 --- src/simulation/m_data_output.fpp | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/simulation/m_data_output.fpp b/src/simulation/m_data_output.fpp index a4107af61..1a72bc6ed 100644 --- a/src/simulation/m_data_output.fpp +++ b/src/simulation/m_data_output.fpp @@ -580,7 +580,7 @@ contains if ((prim_vars_wrt .or. (n == 0 .and. p == 0)) .and. (.not. igr)) then call s_convert_conservative_to_primitive_variables(q_cons_vf, q_T_sf, q_prim_vf, idwint) do i = 1, sys_size - $:GPU_UPDATE(host='[q_prim_vf(i)%sf(:,:,:)]') + $:GPU_UPDATE(host='[q_prim_vf(i)%sf(:, :, :)]') end do ! q_prim_vf(eqn_idx%bub%beg) stores the value of nb needed in riemann solvers, so replace with true primitive value ! (=1._wp) @@ -1021,7 +1021,8 @@ contains disp = m_MOK*max(MOK, n_MOK)*max(MOK, p_MOK)*WP_MOK*(var_MOK - 1) call MPI_FILE_SET_VIEW(ifile, disp, mpi_p, MPI_IO_DATA%view(sys_size + 1), 'native', mpi_info_int, ierr) - call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(sys_size + 1)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, ierr) + call MPI_FILE_WRITE_ALL(ifile, MPI_IO_DATA%var(sys_size + 1)%sf(:,:,:), data_size*mpi_io_type, mpi_io_p, status, & + & ierr) end if call MPI_FILE_CLOSE(ifile, ierr)