feat(amr): support acoustic sources under dynamic regrid - source support stays coarse (tags suppressed, candidate boxes clipped clear, internal assert); golden 2FC423D3

Author: sbryngelson

src/simulation/m_acoustic_src.fpp

@@ -13,12 +13,17 @@ module m_acoustic_src
     use m_variables_conversion
     use m_helper_basic
     use m_constants
+    use m_mpi_common, only: s_mpi_allreduce_integer_min, s_mpi_allreduce_integer_max
 
     implicit none
 
-    private; public :: s_initialize_acoustic_src, s_precalculate_acoustic_spatial_sources, s_acoustic_src_calculations
+    private; public :: s_initialize_acoustic_src, s_precalculate_acoustic_spatial_sources, s_acoustic_src_calculations, &
+        & acoustic_supp_lo, acoustic_supp_hi
 
-    integer, allocatable, dimension(:) :: pulse, support
+    !> Global (level-0 index space) bounding box of each source's spatial support, reduced over ranks. The AMR dynamic regrid keeps
+    !! fine blocks clear of these (the source acts on the coarse grid only). Allocated/filled only when amr with acoustic_source.
+    integer, allocatable, dimension(:,:) :: acoustic_supp_lo, acoustic_supp_hi  !< (1:3, 1:num_source)
+    integer, allocatable, dimension(:)   :: pulse, support
     $:GPU_DECLARE(create='[pulse, support]')
 
     logical, allocatable, dimension(:) :: dipole
@@ -120,6 +125,9 @@ contains
         @:ALLOCATE(mom_src(1:num_vels, 0:m, 0:n, 0:p))
         @:ALLOCATE(E_src(0:m, 0:n, 0:p))
 
+        ! host-only helper for the AMR regrid's source-exclusion clipping (filled by the precompute)
+        if (amr) allocate (acoustic_supp_lo(1:3,1:num_source), acoustic_supp_hi(1:3,1:num_source))
+
     end subroutine s_initialize_acoustic_src
 
     !> Compute mass, momentum, and energy acoustic source terms and add to the RHS
@@ -394,6 +402,7 @@ contains
         integer             :: j, k, l, ai
         integer             :: count
         integer             :: dim
+        integer             :: sidx_supp(3), lo_loc, hi_loc
         real(wp)            :: source_spatial, angle, xyz_to_r_ratios(3)
         real(wp), parameter :: threshold = 1.e-10_wp
 
@@ -472,6 +481,22 @@ contains
                                          & // 'the source acts on the coarse grid only - move the source or the block apart')
                     end if
                 end do
+
+                ! global support bounding box (all ranks agree): the dynamic regrid suppresses tags
+                ! and clips candidate boxes against it so fine blocks never cover the source
+                sidx_supp = 0
+                sidx_supp(1) = start_idx(1)
+                if (n_glb > 0) sidx_supp(2) = start_idx(2)
+                if (p_glb > 0) sidx_supp(3) = start_idx(3)
+                do j = 1, 3
+                    lo_loc = huge(1); hi_loc = -huge(1)
+                    do k = 1, count
+                        lo_loc = min(lo_loc, int(source_spatials(ai)%coord(j, k)) + sidx_supp(j))
+                        hi_loc = max(hi_loc, int(source_spatials(ai)%coord(j, k)) + sidx_supp(j))
+                    end do
+                    call s_mpi_allreduce_integer_min(lo_loc, acoustic_supp_lo(j, ai))
+                    call s_mpi_allreduce_integer_max(hi_loc, acoustic_supp_hi(j, ai))
+                end do
             end if
 
             if (count > 0) then

src/simulation/m_amr.fpp

@@ -24,6 +24,7 @@ module m_amr
     use m_ibm, only: s_ibm_alloc_fine, s_ibm_setup_fine, s_ibm_swap_to_fine, s_ibm_restore_from_fine, s_ibm_correct_state, &
         & s_update_mib, moving_immersed_boundary_flag, num_gps
     use m_hypoelastic, only: s_hypoelastic_update_fd_coeffs
+    use m_acoustic_src, only: acoustic_supp_lo, acoustic_supp_hi
 
     implicit none
 
@@ -1391,6 +1392,62 @@ contains
     !! amr_buf-padded extents come within buff_size (guaranteeing no fine-fine adjacency: separated boxes stay >= buff_size apart,
     !! nearby ones collapse to a single box == the legacy bounding box). Boxes are the raw tagged extents; the caller pads, clamps
     !! and size-caps each one.
+    !> True iff global level-0 cell (gi, gj, gk) lies inside any acoustic source support bbox.
+    pure logical function f_in_acoustic_support(gi, gj, gk) result(insup)
+
+        integer, intent(in) :: gi, gj, gk
+        integer             :: s
+
+        insup = .false.
+        do s = 1, num_source
+            if (gi >= acoustic_supp_lo(1, s) .and. gi <= acoustic_supp_hi(1, s) .and. (n_glb == 0 .or. (gj >= acoustic_supp_lo(2, &
+                & s) .and. gj <= acoustic_supp_hi(2, s))) .and. (p_glb == 0 .or. (gk >= acoustic_supp_lo(3, &
+                & s) .and. gk <= acoustic_supp_hi(3, s)))) then
+                insup = .true.; return
+            end if
+        end do
+
+    end function f_in_acoustic_support
+
+    !> Clip a candidate regrid box (global indices) so it does not overlap any acoustic source support bbox: per overlapping source,
+    !! remove the overlap along the single axis/side that keeps the largest remaining extent (deterministic: lower axis, then begin
+    !! side, wins ties). Clipping only shrinks the box and may empty it (hi < lo); the caller drops empties.
+    impure subroutine s_amr_clip_box_from_sources(lo, hi)
+
+        integer, intent(inout) :: lo(3), hi(3)
+        integer                :: s, d, best_d, best_side, best_ext, ext_l, ext_r
+        logical                :: ovl
+
+        do s = 1, num_source
+            if (hi(1) < lo(1) .or. hi(2) < lo(2) .or. hi(3) < lo(3)) return  ! emptied by an earlier clip
+            ovl = lo(1) <= acoustic_supp_hi(1, s) .and. hi(1) >= acoustic_supp_lo(1, s)
+            if (n_glb > 0) ovl = ovl .and. lo(2) <= acoustic_supp_hi(2, s) .and. hi(2) >= acoustic_supp_lo(2, s)
+            if (p_glb > 0) ovl = ovl .and. lo(3) <= acoustic_supp_hi(3, s) .and. hi(3) >= acoustic_supp_lo(3, s)
+            if (.not. ovl) cycle
+            best_d = 1; best_side = 1; best_ext = -1
+            do d = 1, num_dims
+                ext_l = acoustic_supp_lo(d, s) - lo(d)  ! cells kept by [lo(d), supp_lo-1]
+                ext_r = hi(d) - acoustic_supp_hi(d, s)  ! cells kept by [supp_hi+1, hi(d)]
+                if (ext_l > best_ext) then; best_ext = ext_l; best_d = d; best_side = 1; end if
+                if (ext_r > best_ext) then; best_ext = ext_r; best_d = d; best_side = 2; end if
+            end do
+            if (best_side == 1) then
+                hi(best_d) = acoustic_supp_lo(best_d, s) - 1
+            else
+                lo(best_d) = acoustic_supp_hi(best_d, s) + 1
+            end if
+        end do
+        ! safety net: clipping removed every overlap by construction - anything left is a bug
+        do s = 1, num_source
+            if (hi(1) < lo(1) .or. hi(2) < lo(2) .or. hi(3) < lo(3)) return
+            ovl = lo(1) <= acoustic_supp_hi(1, s) .and. hi(1) >= acoustic_supp_lo(1, s)
+            if (n_glb > 0) ovl = ovl .and. lo(2) <= acoustic_supp_hi(2, s) .and. hi(2) >= acoustic_supp_lo(2, s)
+            if (p_glb > 0) ovl = ovl .and. lo(3) <= acoustic_supp_hi(3, s) .and. hi(3) >= acoustic_supp_lo(3, s)
+            if (ovl) call s_mpi_abort('amr regrid: acoustic source exclusion clip failed (internal error)')
+        end do
+
+    end subroutine s_amr_clip_box_from_sources
+
     impure subroutine s_amr_cluster(tag_grid, boxes, nboxes)
 
         logical, intent(in)                   :: tag_grid(0:,0:,0:)
@@ -1541,6 +1598,11 @@ contains
                         if (p_glb > 0) g = max(g, abs(f_amr_rho_tot(q_cons_base, ci, cj, ck + 1) - f_amr_rho_tot(q_cons_base, ci, &
                             & cj, ck - 1)))
                         if (g/(2._wp*r0) > amr_tag_eps) tag_grid(ci, cj, ck) = .true.
+                        ! the acoustic source support stays coarse (its spatials are coarse cell
+                        ! indices): suppress tags there so the clusterer splits around the source
+                        if (acoustic_source .and. tag_grid(ci, cj, ck)) then
+                            if (f_in_acoustic_support(ci + sidx(1), cj + sidx(2), ck + sidx(3))) tag_grid(ci, cj, ck) = .false.
+                        end if
                     end do
                 end do
             end do
@@ -1569,6 +1631,9 @@ contains
                 else
                     lo(3) = 0; hi(3) = 0
                 end if
+                ! keep candidate boxes clear of every acoustic source support (the source acts on the
+                ! coarse grid only); clipping only shrinks, so boxes stay disjoint - empties drop below
+                if (acoustic_source) call s_amr_clip_box_from_sources(lo, hi)
                 if (hi(1) < lo(1) .or. hi(2) < lo(2) .or. hi(3) < lo(3)) cycle  ! confined to the domain margin
                 k = k + 1; boxes(k)%lo = lo; boxes(k)%hi = hi
             end do

src/simulation/m_checker.fpp

@@ -117,10 +117,9 @@ contains
             @:PROHIBIT(hybrid_weno, "amr is incompatible with hybrid_weno (unvalidated combination)")
             @:PROHIBIT(hybrid_riemann, "amr is incompatible with hybrid_riemann (unvalidated combination)")
             ! acoustic sources act on the coarse grid only (their spatial support is precomputed as
-            ! coarse cell indices); a startup check aborts if the support overlaps the static block.
-            ! Dynamic regrid stays gated: new blocks could appear anywhere, including on the source.
-            @:PROHIBIT(acoustic_source .and. amr_regrid_int > 0, &
-                       & "amr with acoustic_source requires a static block (amr_regrid_int = 0): the source support is precomputed on the coarse grid and must not overlap a fine block")
+            ! coarse cell indices). A startup check aborts if the support overlaps the user-placed
+            ! initial block; the dynamic regrid keeps its own boxes clear of the support (tags are
+            ! suppressed over it and candidate boxes are clipped), so the source region stays coarse.
             @:PROHIBIT(any(amr_block_beg(1:num_dims) < 0), "amr_block_beg must be >= 0")
             @:PROHIBIT(amr_block_end(1) > m_glb .or. (num_dims >= 2 .and. amr_block_end(2) > n_glb) .or. (num_dims >= 3 &
                        & .and. amr_block_end(3) > p_glb), "amr_block_end must be <= global cell max per axis")