bug fixes and IBM halo exchange fix

wilfonba · wilfonba · commit f2e5692c4558 · 2025-05-05T22:57:08.000-04:00
diff --git a/src/simulation/m_ibm.fpp b/src/simulation/m_ibm.fpp
@@ -85,7 +85,7 @@ contains
         !$acc update device(levelset_norm%sf)
 
         ! Get neighboring IB variables from other processors
-        call s_populate_ib_buffers(ib_markers, gp_layers)
+        call s_populate_ib_buffers(ib_markers)
 
         !$acc update host(ib_markers%sf)
 
@@ -108,15 +108,14 @@ contains
 
     end subroutine s_ibm_setup
 
-    subroutine s_populate_ib_buffers(ib_markers, gp_layers)
+    subroutine s_populate_ib_buffers(ib_markers)
 
         type(integer_field), intent(inout) :: ib_markers
-        integer, intent(in) :: gp_layers
 
         #:for DIRC, DIRI in [('x', 1), ('y', 2), ('z', 3)]
             #:for LOCC, LOCI in [('beg', -1), ('end', 1)]
-                if (bc_${DIRC}$%${LOCC}$ > 0) then
-                    call s_mpi_sendrecv_ib_buffers(ib_markers, gp_layers, ${DIRI}$, ${LOCI}$)
+                if (bc_${DIRC}$%${LOCC}$ >= 0) then
+                    call s_mpi_sendrecv_ib_buffers(ib_markers, ${DIRI}$, ${LOCI}$)
                 end if
             #:endfor
         #:endfor
diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp
@@ -44,8 +44,10 @@ module m_mpi_proxy
 
     !> @name Generic flags used to identify and report MPI errors
     !> @{
-    integer, private :: err_code, ierr, i_halo_size
+    integer, private :: err_code, ierr
     !> @}
+
+    integer :: i_halo_size
     !$acc declare create(i_halo_size)
 
 contains
@@ -70,9 +72,7 @@ contains
             end if
 
             !$acc declare create(i_halo_size)
-
             @:ALLOCATE(ib_buff_send(0:i_halo_size), ib_buff_recv(0:i_halo_size))
-
         end if
 #endif
 
@@ -235,11 +235,11 @@ contains
 
     end subroutine s_mpi_bcast_user_inputs
 
-    subroutine s_mpi_sendrecv_ib_buffers(ib_markers, gp_layers, mpi_dir, pbc_loc)
+    subroutine s_mpi_sendrecv_ib_buffers(ib_markers, mpi_dir, pbc_loc)
 
         type(integer_field), intent(inout) :: ib_markers
 
-        integer, intent(in) :: gp_layers, mpi_dir, pbc_loc
+        integer, intent(in) :: mpi_dir, pbc_loc
 
         integer :: i, j, k, l, r, q !< Generic loop iterators
 
@@ -261,8 +261,8 @@ contains
 
         buffer_counts = (/ &
                         gp_layers*(n + 1)*(p + 1), &
-                        gp_layers*(m + 2*buff_size + 1)*(p + 1), &
-                        gp_layers*(m + 2*buff_size + 1)*(n + 2*buff_size + 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)
@@ -312,8 +312,8 @@ contains
                     !$acc parallel loop collapse(3) gang vector default(present) private(r)
                     do l = 0, p
                         do k = 0, gp_layers - 1
-                            do j = -buff_size, m + buff_size
-                                r = ((j + buff_size) + (m + 2*buff_size + 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
@@ -322,10 +322,10 @@ contains
                 #:else
                     !$acc parallel loop collapse(3) gang vector default(present) private(r)
                     do l = 0, gp_layers - 1
-                        do k = -buff_size, n + buff_size
-                            do j = -buff_size, m + buff_size
-                                r = ((j + buff_size) + (m + 2*buff_size + 1)* &
-                                     ((k + buff_size) + (n + 2*buff_size + 1)*l))
+                        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
@@ -389,8 +389,8 @@ contains
                     !$acc parallel loop collapse(3) gang vector default(present) private(r)
                     do l = 0, p
                         do k = -gp_layers, -1
-                            do j = -buff_size, m + buff_size
-                                r = ((j + buff_size) + (m + 2*buff_size + 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
@@ -400,10 +400,10 @@ contains
                     ! Unpacking buffer from bc_z%beg
                     !$acc parallel loop collapse(3) gang vector default(present) private(r)
                     do l = -gp_layers, -1
-                        do k = -buff_size, n + buff_size
-                            do j = -buff_size, m + buff_size
-                                r = ((j + buff_size) + (m + 2*buff_size + 1)* &
-                                     ((k + buff_size) + (n + 2*buff_size + 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
@@ -420,9 +420,11 @@ contains
     subroutine s_mpi_send_random_number(phi_rn, num_freq)
         integer, intent(in) :: num_freq
         real(wp), intent(inout), dimension(1:num_freq) :: phi_rn
+
 #ifdef MFC_MPI
         call MPI_BCAST(phi_rn, num_freq, mpi_p, 0, MPI_COMM_WORLD, ierr)
 #endif
+
     end subroutine s_mpi_send_random_number
 
     subroutine s_finalize_mpi_proxy_module()
diff --git a/src/simulation/m_start_up.fpp b/src/simulation/m_start_up.fpp
@@ -1480,6 +1480,7 @@ contains
 
 
         call s_initialize_mpi_common_module()
+        call s_initialize_mpi_proxy_module()
         call s_initialize_variables_conversion_module()
         if (grid_geometry == 3) call s_initialize_fftw_module()
         call s_initialize_riemann_solvers_module()
@@ -1686,6 +1687,7 @@ contains
         if (viscous) then
             call s_finalize_viscous_module()
         end if
+        call s_finalize_mpi_proxy_module()
 
         if (surface_tension)  call s_finalize_surface_tension_module()
         if (bodyForces) call s_finalize_body_forces_module()
diff --git a/src/simulation/m_viscous.fpp b/src/simulation/m_viscous.fpp
@@ -1392,7 +1392,7 @@ contains
             end if
         end if
 
-        if (bc_x%beg <= BC_GHOST_EXTRAPOLATION) then
+        if (bc_x%beg <= BC_GHOST_EXTRAP) then
             !$acc parallel loop collapse(2) gang vector default(present)
             do l = idwbuff(3)%beg, idwbuff(3)%end
                 do k = idwbuff(2)%beg, idwbuff(2)%end
@@ -1401,7 +1401,7 @@ contains
                 end do
             end do
         end if
-        if (bc_x%end <= BC_GHOST_EXTRAPOLATION) then
+        if (bc_x%end <= BC_GHOST_EXTRAP) then
             !$acc parallel loop collapse(2) gang vector default(present)
             do l = idwbuff(3)%beg, idwbuff(3)%end
                 do k = idwbuff(2)%beg, idwbuff(2)%end
@@ -1411,7 +1411,7 @@ contains
             end do
         end if
         if (n > 0) then
-            if (bc_y%beg <= BC_GHOST_EXTRAPOLATION .and. bc_y%beg /= BC_NULL) then
+            if (bc_y%beg <= BC_GHOST_EXTRAP .and. bc_y%beg /= BC_NULL) then
                 !$acc parallel loop collapse(2) gang vector default(present)
                 do l = idwbuff(3)%beg, idwbuff(3)%end
                     do j = idwbuff(1)%beg, idwbuff(1)%end
@@ -1420,7 +1420,7 @@ contains
                     end do
                 end do
             end if
-            if (bc_y%end <= BC_GHOST_EXTRAPOLATION) then
+            if (bc_y%end <= BC_GHOST_EXTRAP) then
                 !$acc parallel loop collapse(2) gang vector default(present)
                 do l = idwbuff(3)%beg, idwbuff(3)%end
                     do j = idwbuff(1)%beg, idwbuff(1)%end
@@ -1430,7 +1430,7 @@ contains
                 end do
             end if
             if (p > 0) then
-                if (bc_z%beg <= BC_GHOST_EXTRAPOLATION) then
+                if (bc_z%beg <= BC_GHOST_EXTRAP) then
                     !$acc parallel loop collapse(2) gang vector default(present)
                     do k = idwbuff(2)%beg, idwbuff(2)%end
                         do j = idwbuff(1)%beg, idwbuff(1)%end
@@ -1440,7 +1440,7 @@ contains
                         end do
                     end do
                 end if
-                if (bc_z%end <= BC_GHOST_EXTRAPOLATION) then
+                if (bc_z%end <= BC_GHOST_EXTRAP) then
                     !$acc parallel loop collapse(2) gang vector default(present)
                     do k = idwbuff(2)%beg, idwbuff(2)%end
                         do j = idwbuff(1)%beg, idwbuff(1)%end
diff --git a/src/simulation/m_weno.fpp b/src/simulation/m_weno.fpp
@@ -272,12 +272,12 @@ contains
                     ! any contributions from outside of the physical domain during
                     ! the WENO reconstruction
                     if (null_weights) then
-                        if (bc_s%beg == BC_RIEMANN_EXTRAPOLATION) then
+                        if (bc_s%beg == BC_RIEMANN_EXTRAP) then
                             d_cbR_${XYZ}$ (1, 0) = 0._wp; d_cbR_${XYZ}$ (0, 0) = 1._wp
                             d_cbL_${XYZ}$ (1, 0) = 0._wp; d_cbL_${XYZ}$ (0, 0) = 1._wp
                         end if
 
-                        if (bc_s%end == BC_RIEMANN_EXTRAPOLATION) then
+                        if (bc_s%end == BC_RIEMANN_EXTRAP) then
                             d_cbR_${XYZ}$ (0, s) = 0._wp; d_cbR_${XYZ}$ (1, s) = 1._wp
                             d_cbL_${XYZ}$ (0, s) = 0._wp; d_cbL_${XYZ}$ (1, s) = 1._wp
                         end if
@@ -418,14 +418,14 @@ contains
                     ! any contributions from outside of the physical domain during
                     ! the WENO reconstruction
                     if (null_weights) then
-                        if (bc_s%beg == BC_RIEMANN_EXTRAPOLATION) then
+                        if (bc_s%beg == BC_RIEMANN_EXTRAP) then
                             d_cbR_${XYZ}$ (1:2, 0) = 0._wp; d_cbR_${XYZ}$ (0, 0) = 1._wp
                             d_cbL_${XYZ}$ (1:2, 0) = 0._wp; d_cbL_${XYZ}$ (0, 0) = 1._wp
                             d_cbR_${XYZ}$ (2, 1) = 0._wp; d_cbR_${XYZ}$ (:, 1) = d_cbR_${XYZ}$ (:, 1)/sum(d_cbR_${XYZ}$ (:, 1))
                             d_cbL_${XYZ}$ (2, 1) = 0._wp; d_cbL_${XYZ}$ (:, 1) = d_cbL_${XYZ}$ (:, 1)/sum(d_cbL_${XYZ}$ (:, 1))
                         end if
 
-                        if (bc_s%end == BC_RIEMANN_EXTRAPOLATION) then
+                        if (bc_s%end == BC_RIEMANN_EXTRAP) then
                             d_cbR_${XYZ}$ (0, s - 1) = 0._wp; d_cbR_${XYZ}$ (:, s - 1) = d_cbR_${XYZ}$ (:, s - 1)/sum(d_cbR_${XYZ}$ (:, s - 1))
                             d_cbL_${XYZ}$ (0, s - 1) = 0._wp; d_cbL_${XYZ}$ (:, s - 1) = d_cbL_${XYZ}$ (:, s - 1)/sum(d_cbL_${XYZ}$ (:, s - 1))
                             d_cbR_${XYZ}$ (0:1, s) = 0._wp; d_cbR_${XYZ}$ (2, s) = 1._wp
