Skip to content
54 changes: 27 additions & 27 deletions src/common/m_mpi_common.fpp
Original file line number Diff line number Diff line change
Expand Up @@ -58,7 +58,7 @@ contains
! the largest buffer in the computational domain.

if (qbmm .and. .not. polytropic) then
v_size = sys_size + 2*nb*4
v_size = sys_size + 2*nb*nnode
else
v_size = sys_size
end if
Expand Down Expand Up @@ -190,7 +190,7 @@ contains

#ifndef MFC_POST_PROCESS
if (qbmm .and. .not. polytropic) then
do i = sys_size + 1, sys_size + 2*nb*4
do i = sys_size + 1, sys_size + 2*nb*nnode
call MPI_TYPE_CREATE_SUBARRAY(num_dims, sizes_glb, sizes_loc, start_idx, &
MPI_ORDER_FORTRAN, mpi_p, MPI_IO_DATA%view(i), ierr)
call MPI_TYPE_COMMIT(MPI_IO_DATA%view(i), ierr)
Expand Down Expand Up @@ -675,7 +675,7 @@ contains

if (present(pb_in) .and. present(mv_in) .and. qbmm .and. .not. polytropic) then
qbmm_comm = .true.
v_size = nVar + 2*nb*4
v_size = nVar + 2*nb*nnode
buffer_counts = (/ &
buff_size*v_size*(n + 1)*(p + 1), &
buff_size*v_size*(m + 2*buff_size + 1)*(p + 1), &
Expand Down Expand Up @@ -744,9 +744,9 @@ contains
do l = 0, p
do k = 0, n
do j = 0, buff_size - 1
do i = nVar + 1, nVar + 4
do i = nVar + 1, nVar + nnode
do q = 1, nb
r = (i - 1) + (q - 1)*4 + v_size* &
r = (i - 1) + (q - 1)*nnode + v_size* &
(j + buff_size*(k + (n + 1)*l))
buff_send(r) = real(pb_in(j + pack_offset, k, l, i - nVar, q), kind=wp)
end do
Expand All @@ -760,9 +760,9 @@ contains
do l = 0, p
do k = 0, n
do j = 0, buff_size - 1
do i = nVar + 1, nVar + 4
do i = nVar + 1, nVar + nnode
do q = 1, nb
r = (i - 1) + (q - 1)*4 + nb*4 + v_size* &
r = (i - 1) + (q - 1)*nnode + nb*nnode + v_size* &
(j + buff_size*(k + (n + 1)*l))
buff_send(r) = real(mv_in(j + pack_offset, k, l, i - nVar, q), kind=wp)
end do
Expand Down Expand Up @@ -790,12 +790,12 @@ contains

if (qbmm_comm) then
$:GPU_PARALLEL_LOOP(collapse=5,private='[r]')
do i = nVar + 1, nVar + 4
do i = nVar + 1, nVar + nnode
do l = 0, p
do k = 0, buff_size - 1
do j = -buff_size, m + buff_size
do q = 1, nb
r = (i - 1) + (q - 1)*4 + v_size* &
r = (i - 1) + (q - 1)*nnode + v_size* &
((j + buff_size) + (m + 2*buff_size + 1)* &
(k + buff_size*l))
buff_send(r) = real(pb_in(j, k + pack_offset, l, i - nVar, q), kind=wp)
Expand All @@ -807,12 +807,12 @@ contains
$:END_GPU_PARALLEL_LOOP()

$:GPU_PARALLEL_LOOP(collapse=5,private='[r]')
do i = nVar + 1, nVar + 4
do i = nVar + 1, nVar + nnode
do l = 0, p
do k = 0, buff_size - 1
do j = -buff_size, m + buff_size
do q = 1, nb
r = (i - 1) + (q - 1)*4 + nb*4 + v_size* &
r = (i - 1) + (q - 1)*nnode + nb*nnode + v_size* &
((j + buff_size) + (m + 2*buff_size + 1)* &
(k + buff_size*l))
buff_send(r) = real(mv_in(j, k + pack_offset, l, i - nVar, q), kind=wp)
Expand Down Expand Up @@ -841,12 +841,12 @@ contains

if (qbmm_comm) then
$:GPU_PARALLEL_LOOP(collapse=5,private='[r]')
do i = nVar + 1, nVar + 4
do i = nVar + 1, nVar + nnode
do l = 0, buff_size - 1
do k = -buff_size, n + buff_size
do j = -buff_size, m + buff_size
do q = 1, nb
r = (i - 1) + (q - 1)*4 + v_size* &
r = (i - 1) + (q - 1)*nnode + v_size* &
((j + buff_size) + (m + 2*buff_size + 1)* &
((k + buff_size) + (n + 2*buff_size + 1)*l))
buff_send(r) = real(pb_in(j, k, l + pack_offset, i - nVar, q), kind=wp)
Expand All @@ -858,12 +858,12 @@ contains
$:END_GPU_PARALLEL_LOOP()

$:GPU_PARALLEL_LOOP(collapse=5,private='[r]')
do i = nVar + 1, nVar + 4
do i = nVar + 1, nVar + nnode
do l = 0, buff_size - 1
do k = -buff_size, n + buff_size
do j = -buff_size, m + buff_size
do q = 1, nb
r = (i - 1) + (q - 1)*4 + nb*4 + v_size* &
r = (i - 1) + (q - 1)*nnode + nb*nnode + v_size* &
((j + buff_size) + (m + 2*buff_size + 1)* &
((k + buff_size) + (n + 2*buff_size + 1)*l))
buff_send(r) = real(mv_in(j, k, l + pack_offset, i - nVar, q), kind=wp)
Expand Down Expand Up @@ -952,9 +952,9 @@ contains
do l = 0, p
do k = 0, n
do j = -buff_size, -1
do i = nVar + 1, nVar + 4
do i = nVar + 1, nVar + nnode
do q = 1, nb
r = (i - 1) + (q - 1)*4 + v_size* &
r = (i - 1) + (q - 1)*nnode + v_size* &
(j + buff_size*((k + 1) + (n + 1)*l))
pb_in(j + unpack_offset, k, l, i - nVar, q) = real(buff_recv(r), kind=stp)
end do
Expand All @@ -968,9 +968,9 @@ contains
do l = 0, p
do k = 0, n
do j = -buff_size, -1
do i = nVar + 1, nVar + 4
do i = nVar + 1, nVar + nnode
do q = 1, nb
r = (i - 1) + (q - 1)*4 + nb*4 + v_size* &
r = (i - 1) + (q - 1)*nnode + nb*nnode + v_size* &
(j + buff_size*((k + 1) + (n + 1)*l))
mv_in(j + unpack_offset, k, l, i - nVar, q) = real(buff_recv(r), kind=stp)
end do
Expand Down Expand Up @@ -1004,12 +1004,12 @@ contains

if (qbmm_comm) then
$:GPU_PARALLEL_LOOP(collapse=5,private='[r]')
do i = nVar + 1, nVar + 4
do i = nVar + 1, nVar + nnode
do l = 0, p
do k = -buff_size, -1
do j = -buff_size, m + buff_size
do q = 1, nb
r = (i - 1) + (q - 1)*4 + v_size* &
r = (i - 1) + (q - 1)*nnode + v_size* &
((j + buff_size) + (m + 2*buff_size + 1)* &
((k + buff_size) + buff_size*l))
pb_in(j, k + unpack_offset, l, i - nVar, q) = real(buff_recv(r), kind=stp)
Expand All @@ -1021,12 +1021,12 @@ contains
$:END_GPU_PARALLEL_LOOP()

$:GPU_PARALLEL_LOOP(collapse=5,private='[r]')
do i = nVar + 1, nVar + 4
do i = nVar + 1, nVar + nnode
do l = 0, p
do k = -buff_size, -1
do j = -buff_size, m + buff_size
do q = 1, nb
r = (i - 1) + (q - 1)*4 + nb*4 + v_size* &
r = (i - 1) + (q - 1)*nnode + nb*nnode + v_size* &
((j + buff_size) + (m + 2*buff_size + 1)* &
((k + buff_size) + buff_size*l))
mv_in(j, k + unpack_offset, l, i - nVar, q) = real(buff_recv(r), kind=stp)
Expand Down Expand Up @@ -1063,12 +1063,12 @@ contains

if (qbmm_comm) then
$:GPU_PARALLEL_LOOP(collapse=5,private='[r]')
do i = nVar + 1, nVar + 4
do i = nVar + 1, nVar + nnode
do l = -buff_size, -1
do k = -buff_size, n + buff_size
do j = -buff_size, m + buff_size
do q = 1, nb
r = (i - 1) + (q - 1)*4 + v_size* &
r = (i - 1) + (q - 1)*nnode + v_size* &
((j + buff_size) + (m + 2*buff_size + 1)* &
((k + buff_size) + (n + 2*buff_size + 1)* &
(l + buff_size)))
Expand All @@ -1081,12 +1081,12 @@ contains
$:END_GPU_PARALLEL_LOOP()

$:GPU_PARALLEL_LOOP(collapse=5,private='[r]')
do i = nVar + 1, nVar + 4
do i = nVar + 1, nVar + nnode
do l = -buff_size, -1
do k = -buff_size, n + buff_size
do j = -buff_size, m + buff_size
do q = 1, nb
r = (i - 1) + (q - 1)*4 + nb*4 + v_size* &
r = (i - 1) + (q - 1)*nnode + nb*nnode + v_size* &
((j + buff_size) + (m + 2*buff_size + 1)* &
((k + buff_size) + (n + 2*buff_size + 1)* &
(l + buff_size)))
Expand Down
16 changes: 14 additions & 2 deletions src/post_process/m_global_parameters.fpp
Original file line number Diff line number Diff line change
Expand Up @@ -858,8 +858,14 @@ contains
chemxe = species_idx%end

#ifdef MFC_MPI
allocate (MPI_IO_DATA%view(1:sys_size))
allocate (MPI_IO_DATA%var(1:sys_size))
if (qbmm .and. .not. polytropic) then
allocate (MPI_IO_DATA%view(1:sys_size + 2*nb*nnode))
allocate (MPI_IO_DATA%var(1:sys_size + 2*nb*nnode))
else
allocate (MPI_IO_DATA%view(1:sys_size))
allocate (MPI_IO_DATA%var(1:sys_size))
end if

do i = 1, sys_size
if (down_sample) then
allocate (MPI_IO_DATA%var(i)%sf(-1:m + 1, -1:n + 1, -1:p + 1))
Expand All @@ -868,6 +874,12 @@ contains
end if
MPI_IO_DATA%var(i)%sf => null()
end do
if (qbmm .and. .not. polytropic) then
do i = sys_size + 1, sys_size + 2*nb*nnode
allocate (MPI_IO_DATA%var(i)%sf(0:m, 0:n, 0:p))
MPI_IO_DATA%var(i)%sf => null()
end do
end if

if (ib) allocate (MPI_IO_IB_DATA%var%sf(0:m, 0:n, 0:p))
#endif
Expand Down
8 changes: 4 additions & 4 deletions src/pre_process/m_global_parameters.fpp
Original file line number Diff line number Diff line change
Expand Up @@ -564,7 +564,7 @@ contains
patch_ib(i)%model_spc = num_ray
patch_ib(i)%model_threshold = ray_tracing_threshold

! Variables to handle moving imersed boundaries, defaulting to no movement
! Variables to handle moving immersed boundaries, defaulting to no movement
patch_ib(i)%moving_ibm = 0
patch_ib(i)%vel(:) = 0._wp
patch_ib(i)%angles(:) = 0._wp
Expand Down Expand Up @@ -924,8 +924,8 @@ contains
#ifdef MFC_MPI

if (qbmm .and. .not. polytropic) then
allocate (MPI_IO_DATA%view(1:sys_size + 2*nb*4))
allocate (MPI_IO_DATA%var(1:sys_size + 2*nb*4))
allocate (MPI_IO_DATA%view(1:sys_size + 2*nb*nnode))
allocate (MPI_IO_DATA%var(1:sys_size + 2*nb*nnode))
else
allocate (MPI_IO_DATA%view(1:sys_size))
allocate (MPI_IO_DATA%var(1:sys_size))
Expand All @@ -938,7 +938,7 @@ contains
end do
end if
if (qbmm .and. .not. polytropic) then
do i = sys_size + 1, sys_size + 2*nb*4
do i = sys_size + 1, sys_size + 2*nb*nnode
allocate (MPI_IO_DATA%var(i)%sf(0:m, 0:n, 0:p))
MPI_IO_DATA%var(i)%sf => null()
end do
Expand Down
6 changes: 3 additions & 3 deletions src/pre_process/m_start_up.fpp
Original file line number Diff line number Diff line change
Expand Up @@ -476,10 +476,10 @@ contains
end do

do i = 1, nb
do r = 1, 4
do r = 1, nnode
! Checking whether data file associated with variable position
! of the currently manipulated bubble variable exists
write (file_num, '(I0)') sys_size + r + (i - 1)*4
write (file_num, '(I0)') sys_size + r + (i - 1)*nnode
file_loc = trim(t_step_dir)//'/mv'// &
trim(file_num)//'.dat'
inquire (FILE=trim(file_loc), EXIST=file_check)
Expand Down Expand Up @@ -679,7 +679,7 @@ contains
end do

if (qbmm .and. .not. polytropic) then
do i = sys_size + 1, sys_size + 2*nb*4
do i = sys_size + 1, sys_size + 2*nb*nnode
var_MOK = int(i, MPI_OFFSET_KIND)

! Initial displacement to skip at beginning of file
Expand Down
8 changes: 4 additions & 4 deletions src/simulation/m_global_parameters.fpp
Original file line number Diff line number Diff line change
Expand Up @@ -879,7 +879,7 @@ contains
patch_ib(i)%model_spc = num_ray
patch_ib(i)%model_threshold = ray_tracing_threshold

! Variables to handle moving imersed boundaries, defaulting to no movement
! Variables to handle moving immersed boundaries, defaulting to no movement
patch_ib(i)%moving_ibm = 0
patch_ib(i)%vel(:) = 0._wp
patch_ib(i)%angles(:) = 0._wp
Expand Down Expand Up @@ -1215,8 +1215,8 @@ contains
end if

if (bubbles_euler .and. qbmm .and. .not. polytropic) then
allocate (MPI_IO_DATA%view(1:sys_size + 2*nb*4))
allocate (MPI_IO_DATA%var(1:sys_size + 2*nb*4))
allocate (MPI_IO_DATA%view(1:sys_size + 2*nb*nnode))
allocate (MPI_IO_DATA%var(1:sys_size + 2*nb*nnode))
elseif (bubbles_lagrange) then
allocate (MPI_IO_DATA%view(1:sys_size + 1))
allocate (MPI_IO_DATA%var(1:sys_size + 1))
Expand All @@ -1232,7 +1232,7 @@ contains
end do
end if
if (bubbles_euler .and. qbmm .and. .not. polytropic) then
do i = sys_size + 1, sys_size + 2*nb*4
do i = sys_size + 1, sys_size + 2*nb*nnode
allocate (MPI_IO_DATA%var(i)%sf(0:m, 0:n, 0:p))
MPI_IO_DATA%var(i)%sf => null()
end do
Expand Down
Loading