Skip to content

Commit a80e777

Browse files
sbryngelsonsbryngelson
committed
Make MPI I/O field binding stage-independent
1 parent 83a05fd commit a80e777

6 files changed

Lines changed: 54 additions & 57 deletions

File tree

‎src/common/m_mpi_common.fpp‎

Lines changed: 31 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -109,17 +109,25 @@ contains
109109
end subroutine s_mpi_initialize
110110

111111
!> Set up MPI I/O data views and variable pointers for parallel file output.
112-
impure subroutine s_initialize_mpi_data(q_cons_vf, ib_markers, beta)
112+
impure subroutine s_initialize_mpi_data(q_cons_vf, ib_markers, ib_mpi_data, beta, qbmm_pb, qbmm_mv)
113113

114114
type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
115115
type(integer_field), optional, intent(in) :: ib_markers
116+
type(mpi_io_ib_var), optional, intent(inout) :: ib_mpi_data
116117
type(scalar_field), intent(in), optional :: beta
118+
type(pres_field), intent(in), optional :: qbmm_pb, qbmm_mv
117119
integer, dimension(num_dims) :: sizes_glb, sizes_loc
118120

119121
#ifdef MFC_MPI
120122
integer :: i, j
121123
integer :: ierr !< Generic flag used to identify and report MPI errors
122124
integer :: alt_sys
125+
logical :: bind_qbmm_fields
126+
127+
if (present(qbmm_pb) .neqv. present(qbmm_mv)) then
128+
call s_mpi_abort('QBMM MPI I/O requires both pressure and moment fields.')
129+
end if
130+
bind_qbmm_fields = qbmm .and. .not. polytropic .and. present(qbmm_pb) .and. present(qbmm_mv)
123131

124132
if (present(beta)) then
125133
alt_sys = sys_size + 1
@@ -136,16 +144,11 @@ contains
136144
end if
137145

138146
! Additional variables pb and mv for non-polytropic qbmm
139-
if (qbmm .and. .not. polytropic) then
147+
if (bind_qbmm_fields) then
140148
do i = 1, nb
141149
do j = 1, nnode
142-
#ifdef MFC_PRE_PROCESS
143-
MPI_IO_DATA%var(sys_size + (i - 1)*nnode + j)%sf => pb%sf(0:m,0:n,0:p,j, i)
144-
MPI_IO_DATA%var(sys_size + (i - 1)*nnode + j + nb*nnode)%sf => mv%sf(0:m,0:n,0:p,j, i)
145-
#elif defined (MFC_SIMULATION)
146-
MPI_IO_DATA%var(sys_size + (i - 1)*nnode + j)%sf => pb_ts(1)%sf(0:m,0:n,0:p,j, i)
147-
MPI_IO_DATA%var(sys_size + (i - 1)*nnode + j + nb*nnode)%sf => mv_ts(1)%sf(0:m,0:n,0:p,j, i)
148-
#endif
150+
MPI_IO_DATA%var(sys_size + (i - 1)*nnode + j)%sf => qbmm_pb%sf(0:m,0:n,0:p,j, i)
151+
MPI_IO_DATA%var(sys_size + (i - 1)*nnode + j + nb*nnode)%sf => qbmm_mv%sf(0:m,0:n,0:p,j, i)
149152
end do
150153
end do
151154
end if
@@ -166,56 +169,46 @@ contains
166169
call MPI_TYPE_COMMIT(MPI_IO_DATA%view(i), ierr)
167170
end do
168171

169-
#ifndef MFC_POST_PROCESS
170-
if (qbmm .and. .not. polytropic) then
172+
if (bind_qbmm_fields) then
171173
do i = sys_size + 1, sys_size + 2*nb*nnode
172174
call MPI_TYPE_CREATE_SUBARRAY(num_dims, sizes_glb, sizes_loc, start_idx, MPI_ORDER_FORTRAN, mpi_p, &
173175
& MPI_IO_DATA%view(i), ierr)
174176
call MPI_TYPE_COMMIT(MPI_IO_DATA%view(i), ierr)
175177
end do
176178
end if
177-
#endif
178179

179-
#ifndef MFC_PRE_PROCESS
180-
if (present(ib_markers)) then
181-
MPI_IO_IB_DATA%var%sf => ib_markers%sf(0:m,0:n,0:p)
180+
if (present(ib_markers) .neqv. present(ib_mpi_data)) then
181+
call s_mpi_abort('Immersed-boundary MPI I/O requires both marker and descriptor fields.')
182+
end if
182183

184+
if (present(ib_markers)) then
185+
ib_mpi_data%var%sf => ib_markers%sf(0:m,0:n,0:p)
183186
call MPI_TYPE_CREATE_SUBARRAY(num_dims, sizes_glb, sizes_loc, start_idx, MPI_ORDER_FORTRAN, MPI_INTEGER, &
184-
& MPI_IO_IB_DATA%view, ierr)
185-
call MPI_TYPE_COMMIT(MPI_IO_IB_DATA%view, ierr)
187+
& ib_mpi_data%view, ierr)
188+
call MPI_TYPE_COMMIT(ib_mpi_data%view, ierr)
186189
end if
187-
#endif
188190
#endif
189191

190192
end subroutine s_initialize_mpi_data
191193

192194
!> Set up MPI I/O data views for downsampled (coarsened) parallel file output.
193-
subroutine s_initialize_mpi_data_ds(q_cons_vf)
195+
subroutine s_initialize_mpi_data_ds(m_ds, n_ds, p_ds, q_cons_vf)
194196

195-
type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
196-
integer, dimension(num_dims) :: sizes_loc
197-
integer, dimension(3) :: sf_start_idx
197+
integer, intent(in) :: m_ds, n_ds, p_ds
198+
type(scalar_field), dimension(sys_size), intent(in), optional :: q_cons_vf
199+
integer, dimension(num_dims) :: sizes_loc
200+
integer, dimension(3) :: sf_start_idx
198201

199202
#ifdef MFC_MPI
200-
integer :: i, m_ds, n_ds, p_ds, ierr
203+
integer :: i, ierr
201204

202205
sf_start_idx = (/0, 0, 0/)
203206

204-
#ifndef MFC_POST_PROCESS
205-
m_ds = int((m + 1)/3) - 1
206-
n_ds = int((n + 1)/3) - 1
207-
p_ds = int((p + 1)/3) - 1
208-
#else
209-
m_ds = m
210-
n_ds = n
211-
p_ds = p
212-
#endif
213-
214-
#ifdef MFC_POST_PROCESS
215-
do i = 1, sys_size
216-
MPI_IO_DATA%var(i)%sf => q_cons_vf(i)%sf(-1:m_ds + 1,-1:n_ds + 1,-1:p_ds + 1)
217-
end do
218-
#endif
207+
if (present(q_cons_vf)) then
208+
do i = 1, sys_size
209+
MPI_IO_DATA%var(i)%sf => q_cons_vf(i)%sf(-1:m_ds + 1,-1:n_ds + 1,-1:p_ds + 1)
210+
end do
211+
end if
219212
! Define global(g) and local(l) sizes for flow variables
220213
sizes_loc(1) = m_ds + 3
221214
if (n > 0) then

‎src/post_process/m_data_input.f90‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -84,7 +84,7 @@ impure subroutine s_setup_mpi_io_params(data_size, m_MOK, n_MOK, p_MOK, WP_MOK,
8484
integer(KIND=MPI_OFFSET_KIND), intent(out) :: WP_MOK, MOK, str_MOK, NVARS_MOK
8585

8686
if (ib) then
87-
call s_initialize_mpi_data(q_cons_vf, ib_markers)
87+
call s_initialize_mpi_data(q_cons_vf, ib_markers=ib_markers, ib_mpi_data=MPI_IO_IB_DATA)
8888
else
8989
call s_initialize_mpi_data(q_cons_vf)
9090
end if
@@ -384,10 +384,10 @@ impure subroutine s_read_parallel_conservative_data(t_step, m_MOK, n_MOK, p_MOK,
384384
call MPI_FILE_OPEN(MPI_COMM_SELF, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr)
385385

386386
if (down_sample) then
387-
call s_initialize_mpi_data_ds(q_cons_temp)
387+
call s_initialize_mpi_data_ds(m, n, p, q_cons_temp)
388388
else
389389
if (ib) then
390-
call s_initialize_mpi_data(q_cons_vf, ib_markers)
390+
call s_initialize_mpi_data(q_cons_vf, ib_markers=ib_markers, ib_mpi_data=MPI_IO_IB_DATA)
391391
else
392392
call s_initialize_mpi_data(q_cons_vf)
393393
end if

‎src/pre_process/m_data_output.fpp‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -457,9 +457,9 @@ contains
457457
call DelayFileAccess(proc_rank)
458458

459459
if (down_sample) then
460-
call s_initialize_mpi_data_ds(q_cons_temp)
460+
call s_initialize_mpi_data_ds(m_ds, n_ds, p_ds)
461461
else
462-
call s_initialize_mpi_data(q_cons_vf)
462+
call s_initialize_mpi_data(q_cons_vf, qbmm_pb=pb, qbmm_mv=mv)
463463
end if
464464

465465
if (cfl_dt) then
@@ -544,7 +544,7 @@ contains
544544

545545
call MPI_FILE_CLOSE(ifile, ierr)
546546
else
547-
call s_initialize_mpi_data(q_cons_vf)
547+
call s_initialize_mpi_data(q_cons_vf, qbmm_pb=pb, qbmm_mv=mv)
548548

549549
if (cfl_dt) then
550550
write (file_loc, '(I0,A)') n_start, '.dat'

‎src/pre_process/m_start_up.fpp‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -424,7 +424,7 @@ contains
424424
if (file_exist) then
425425
call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr)
426426
427-
call s_initialize_mpi_data(q_cons_vf_in)
427+
call s_initialize_mpi_data(q_cons_vf_in, qbmm_pb=pb, qbmm_mv=mv)
428428
429429
data_size = (m + 1)*(n + 1)*(p + 1)
430430

‎src/simulation/m_data_output.fpp‎

Lines changed: 9 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -694,12 +694,13 @@ contains
694694
call s_int_to_str(t_step, t_step_string)
695695

696696
if (down_sample) then
697-
call s_initialize_mpi_data_ds(q_cons_temp_ds)
697+
call s_initialize_mpi_data_ds(m_ds, n_ds, p_ds)
698698
else
699699
if (ib) then
700-
call s_initialize_mpi_data(q_cons_vf, ib_markers)
700+
call s_initialize_mpi_data(q_cons_vf, ib_markers=ib_markers, ib_mpi_data=MPI_IO_IB_DATA, qbmm_pb=pb_ts(1), &
701+
& qbmm_mv=mv_ts(1))
701702
else
702-
call s_initialize_mpi_data(q_cons_vf)
703+
call s_initialize_mpi_data(q_cons_vf, qbmm_pb=pb_ts(1), qbmm_mv=mv_ts(1))
703704
end if
704705
end if
705706

@@ -714,7 +715,7 @@ contains
714715
call s_mpi_barrier()
715716
call DelayFileAccess(proc_rank)
716717

717-
call s_initialize_mpi_data(q_cons_vf)
718+
call s_initialize_mpi_data(q_cons_vf, qbmm_pb=pb_ts(1), qbmm_mv=mv_ts(1))
718719

719720
write (file_loc, '(I0,A,i7.7,A)') t_step, '_', proc_rank, '.dat'
720721
file_loc = trim(case_dir) // '/restart_data/lustre_' // trim(t_step_string) // trim(mpiiofs) // trim(file_loc)
@@ -780,11 +781,12 @@ contains
780781
end if
781782
else
782783
if (ib) then
783-
call s_initialize_mpi_data(q_cons_vf, ib_markers)
784+
call s_initialize_mpi_data(q_cons_vf, ib_markers=ib_markers, ib_mpi_data=MPI_IO_IB_DATA, qbmm_pb=pb_ts(1), &
785+
& qbmm_mv=mv_ts(1))
784786
else if (present(beta)) then
785-
call s_initialize_mpi_data(q_cons_vf, beta=beta)
787+
call s_initialize_mpi_data(q_cons_vf, beta=beta, qbmm_pb=pb_ts(1), qbmm_mv=mv_ts(1))
786788
else
787-
call s_initialize_mpi_data(q_cons_vf)
789+
call s_initialize_mpi_data(q_cons_vf, qbmm_pb=pb_ts(1), qbmm_mv=mv_ts(1))
788790
end if
789791

790792
write (file_loc, '(I0,A)') t_step, '.dat'

‎src/simulation/m_start_up.fpp‎

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -367,12 +367,13 @@ contains
367367
call MPI_FILE_OPEN(MPI_COMM_SELF, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr)
368368

369369
if (down_sample) then
370-
call s_initialize_mpi_data_ds(q_cons_vf)
370+
call s_initialize_mpi_data_ds(m_ds, n_ds, p_ds)
371371
else
372372
if (ib) then
373-
call s_initialize_mpi_data(q_cons_vf, ib_markers)
373+
call s_initialize_mpi_data(q_cons_vf, ib_markers=ib_markers, ib_mpi_data=MPI_IO_IB_DATA, &
374+
& qbmm_pb=pb_ts(1), qbmm_mv=mv_ts(1))
374375
else
375-
call s_initialize_mpi_data(q_cons_vf)
376+
call s_initialize_mpi_data(q_cons_vf, qbmm_pb=pb_ts(1), qbmm_mv=mv_ts(1))
376377
end if
377378
end if
378379

@@ -443,9 +444,10 @@ contains
443444
call MPI_FILE_OPEN(MPI_COMM_WORLD, file_loc, MPI_MODE_RDONLY, mpi_info_int, ifile, ierr)
444445

445446
if (ib) then
446-
call s_initialize_mpi_data(q_cons_vf, ib_markers)
447+
call s_initialize_mpi_data(q_cons_vf, ib_markers=ib_markers, ib_mpi_data=MPI_IO_IB_DATA, qbmm_pb=pb_ts(1), &
448+
& qbmm_mv=mv_ts(1))
447449
else
448-
call s_initialize_mpi_data(q_cons_vf)
450+
call s_initialize_mpi_data(q_cons_vf, qbmm_pb=pb_ts(1), qbmm_mv=mv_ts(1))
449451
end if
450452

451453
data_size = (m + 1)*(n + 1)*(p + 1)

0 commit comments

Comments
 (0)