MPI Refactor

src/post_process/m_global_parameters.fpp

@@ -474,7 +474,7 @@
         integer :: i, j, fac
 
         ! Setting m_root equal to m in the case of a 1D serial simulation
-        if (num_procs > 1 .and. n == 0) m_root = m_glb
+        if (n == 0) m_root = m_glb
 
         ! Gamma/Pi_inf Model
         if (model_eqns == 1) then
@@ -932,7 +932,7 @@
         if (n > 0) then
             deallocate (y_cc, y_cb, dy)
             if (p > 0) then
                 deallocate (z_cc, z_cb, dz)
             end if
         else
             ! Deallocating the grid variables, only used for the 1D simulations,

src/simulation/m_mpi_proxy.fpp

@@ -68,11 +68,11 @@
                                             & (max(m, n) + 2*gp_layers + 1)
                 end if
             else
                 i_halo_size = -1 + gp_layers
             end if
 
             !$acc update device(i_halo_size)
             @:ALLOCATE(ib_buff_send(0:i_halo_size), ib_buff_recv(0:i_halo_size))
         end if
 #endif
 
@@ -235,7 +235,7 @@
 
     end subroutine s_mpi_bcast_user_inputs
 
     subroutine s_mpi_sendrecv_ib_buffers(ib_markers, mpi_dir, pbc_loc)
 
         type(integer_field), intent(inout) :: ib_markers
 
@@ -257,18 +257,18 @@
 
 #ifdef MFC_MPI
 
         call nvtxStartRange("RHS-COMM-PACKBUF")
 
         buffer_counts = (/ &
                         gp_layers*(n + 1)*(p + 1), &
                         gp_layers*(m + 2*gp_layers + 1)*(p + 1), &
                         gp_layers*(m + 2*gp_layers + 1)*(n + 2*gp_layers + 1) &
                         /)
 
         buffer_count = buffer_counts(mpi_dir)
         boundary_conditions = (/bc_x, bc_y, bc_z/)
         beg_end = (/boundary_conditions(mpi_dir)%beg, boundary_conditions(mpi_dir)%end/)
         beg_end_geq_0 = beg_end(max(pbc_loc, 0) - pbc_loc + 1) >= 0
 
         ! Implements:
         ! pbc_loc  bc_x >= 0 -> [send/recv]_tag  [dst/src]_proc
@@ -277,22 +277,22 @@
         ! +1 (=1)      0            ->     [0,1]       [1,1]      | 1 0 [0,1] [end,end]
         ! +1 (=1)      1            ->     [1,1]       [0,1]      | 1 1 [1,1] [beg,end]
 
         send_tag = f_logical_to_int(.not. f_xor(beg_end_geq_0, pbc_loc == 1))
         recv_tag = f_logical_to_int(pbc_loc == 1)
 
         dst_proc = beg_end(1 + f_logical_to_int(f_xor(pbc_loc == 1, beg_end_geq_0)))
         src_proc = beg_end(1 + f_logical_to_int(pbc_loc == 1))
 
         grid_dims = (/m, n, p/)
 
         pack_offset = 0
         if (f_xor(pbc_loc == 1, beg_end_geq_0)) then
             pack_offset = grid_dims(mpi_dir) - gp_layers + 1
         end if
 
         unpack_offset = 0
         if (pbc_loc == 1) then
             unpack_offset = grid_dims(mpi_dir) + gp_layers + 1
         end if
 
         ! Pack Buffer to Send
@@ -300,43 +300,43 @@
             if (mpi_dir == ${mpi_dir}$) then
                 #:if mpi_dir == 1
                     !$acc parallel loop collapse(3) gang vector default(present) private(r)
                     do l = 0, p
                         do k = 0, n
                             do j = 0, gp_layers - 1
                                 r = (j + gp_layers*(k + (n + 1)*l))
                                 ib_buff_send(r) = ib_markers%sf(j + pack_offset, k, l)
                             end do
                         end do
                     end do
                 #:elif mpi_dir == 2
                     !$acc parallel loop collapse(3) gang vector default(present) private(r)
                     do l = 0, p
                         do k = 0, gp_layers - 1
                             do j = -gp_layers, m + gp_layers
                                 r = ((j + gp_layers) + (m + 2*gp_layers + 1)* &
                                      (k + gp_layers*l))
                                 ib_buff_send(r) = ib_markers%sf(j, k + pack_offset, l)
                             end do
                         end do
                     end do
                 #:else
                     !$acc parallel loop collapse(3) gang vector default(present) private(r)
                     do l = 0, gp_layers - 1
                         do k = -gp_layers, n + gp_layers
                             do j = -gp_layers, m + gp_layers
                                 r = ((j + gp_layers) + (m + 2*gp_layers + 1)* &
                                      ((k + gp_layers) + (n + 2*gp_layers + 1)*l))
                                 ib_buff_send(r) = ib_markers%sf(j, k, l + pack_offset)
                             end do
                         end do
                     end do
                 #:endif
             end if
         #:endfor
         call nvtxEndRange ! Packbuf
 
         p_i_send => ib_buff_send(0)
         p_i_recv => ib_buff_recv(0)
 
         ! Send/Recv
         #:for rdma_mpi in [False, True]
@@ -344,75 +344,75 @@
                 #:if rdma_mpi
                     !$acc data attach(p_i_send, p_i_recv)
                     !$acc host_data use_device(p_i_send, p_i_recv)
                     call nvtxStartRange("RHS-COMM-SENDRECV-RDMA")
                 #:else
                     call nvtxStartRange("RHS-COMM-DEV2HOST")
                     !$acc update host(ib_buff_send)
                     call nvtxEndRange
                     call nvtxStartRange("RHS-COMM-SENDRECV-NO-RMDA")
                 #:endif
 
                 call MPI_SENDRECV( &
                     p_i_send, buffer_count, MPI_INTEGER, dst_proc, send_tag, &
                     p_i_recv, buffer_count, MPI_INTEGER, src_proc, recv_tag, &
                     MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
 
                 call nvtxEndRange ! RHS-MPI-SENDRECV-(NO)-RDMA
 
                 #:if rdma_mpi
                     !$acc end host_data
                     !$acc end data
                     !$acc wait
                 #:else
                     call nvtxStartRange("RHS-COMM-HOST2DEV")
                     !$acc update device(ib_buff_recv)
                     call nvtxEndRange
                 #:endif
             end if
         #:endfor
 
         ! Unpack Received Buffer
         call nvtxStartRange("RHS-COMM-UNPACKBUF")
         #:for mpi_dir in [1, 2, 3]
             if (mpi_dir == ${mpi_dir}$) then
                 #:if mpi_dir == 1
                     !$acc parallel loop collapse(3) gang vector default(present) private(r)
                     do l = 0, p
                         do k = 0, n
                             do j = -gp_layers, -1
                                 r = (j + gp_layers*((k + 1) + (n + 1)*l))
                                 ib_markers%sf(j + unpack_offset, k, l) = ib_buff_recv(r)
                             end do
                         end do
                     end do
                 #:elif mpi_dir == 2
                     !$acc parallel loop collapse(3) gang vector default(present) private(r)
                     do l = 0, p
                         do k = -gp_layers, -1
                             do j = -gp_layers, m + gp_layers
                                 r = ((j + gp_layers) + (m + 2*gp_layers + 1)* &
                                      ((k + gp_layers) + gp_layers*l))
                                 ib_markers%sf(j, k + unpack_offset, l) = ib_buff_recv(r)
                             end do
                         end do
                     end do
                 #:else
                     ! Unpacking buffer from bc_z%beg
                     !$acc parallel loop collapse(3) gang vector default(present) private(r)
                     do l = -gp_layers, -1
                         do k = -gp_layers, n + gp_layers
                             do j = -gp_layers, m + gp_layers
                                 r = ((j + gp_layers) + (m + 2*gp_layers + 1)* &
                                      ((k + gp_layers) + (n + 2*gp_layers + 1)* &
                                       (l + gp_layers)))
                                 ib_markers%sf(j, k, l + unpack_offset) = ib_buff_recv(r)
                             end do
                         end do
                     end do
                 #:endif
             end if
         #:endfor
         call nvtxEndRange
 #endif
 
     end subroutine s_mpi_sendrecv_ib_buffers
@@ -429,9 +429,11 @@
 
     subroutine s_finalize_mpi_proxy_module()
 
+#ifdef MFC_MPI
         if (ib) then
             @:DEALLOCATE(ib_buff_send, ib_buff_recv)
         end if
+#endif
 
     end subroutine s_finalize_mpi_proxy_module