|
| 1 | +!> |
| 2 | +!! @file m_particle_bed.fpp |
| 3 | +!! @brief Generates particle beds: converts particle_bed specifications into |
| 4 | +!! individual sphere/circle patch_ib entries before MPI broadcast. |
| 5 | + |
| 6 | +module m_particle_bed |
| 7 | + |
| 8 | + use m_global_parameters |
| 9 | + use m_constants |
| 10 | + |
| 11 | + implicit none |
| 12 | + |
| 13 | + private |
| 14 | + |
| 15 | + public :: s_generate_particle_beds |
| 16 | + |
| 17 | +contains |
| 18 | + |
| 19 | + !> Generate all particle beds and append the resulting particles to patch_ib. |
| 20 | + !! Called on rank 0 only, before s_mpi_bcast_user_inputs. |
| 21 | + !! Uses a spatial hash grid (cell size = min_dist) so each candidate requires |
| 22 | + !! only 3^dim distance checks on average instead of O(n). |
| 23 | + impure subroutine s_generate_particle_beds() |
| 24 | + |
| 25 | + integer :: b, ib_idx, geom |
| 26 | + integer :: n_placed, n_attempts, max_attempts |
| 27 | + real(wp) :: xmin, xmax, ymin, ymax, zmin, zmax, min_dist |
| 28 | + real(wp) :: rx, ry, rz, dist |
| 29 | + integer :: seed |
| 30 | + logical :: overlaps |
| 31 | + real(wp), allocatable :: placed(:, :) |
| 32 | + |
| 33 | + ! Spatial hash grid |
| 34 | + integer :: hash_size, slot |
| 35 | + integer :: bx, by, bz, nbx, nby, nbz |
| 36 | + integer :: dx_b, dy_b, dz_b, dz_lo, dz_hi, j |
| 37 | + integer, allocatable :: hash_head(:), chain_next(:) |
| 38 | + |
| 39 | + if (num_particle_beds == 0) return |
| 40 | + |
| 41 | + do b = 1, num_particle_beds |
| 42 | + xmin = particle_bed(b)%x_centroid - 0.5_wp*particle_bed(b)%length_x |
| 43 | + xmax = particle_bed(b)%x_centroid + 0.5_wp*particle_bed(b)%length_x |
| 44 | + ymin = particle_bed(b)%y_centroid - 0.5_wp*particle_bed(b)%length_y |
| 45 | + ymax = particle_bed(b)%y_centroid + 0.5_wp*particle_bed(b)%length_y |
| 46 | + zmin = particle_bed(b)%z_centroid - 0.5_wp*particle_bed(b)%length_z |
| 47 | + zmax = particle_bed(b)%z_centroid + 0.5_wp*particle_bed(b)%length_z |
| 48 | + |
| 49 | + min_dist = 2._wp*particle_bed(b)%radius + particle_bed(b)%min_spacing |
| 50 | + |
| 51 | + if (p == 0) then |
| 52 | + geom = 2 ! circle for 2D |
| 53 | + dz_lo = 0 |
| 54 | + dz_hi = 0 |
| 55 | + else |
| 56 | + geom = 8 ! sphere for 3D |
| 57 | + dz_lo = -1 |
| 58 | + dz_hi = 1 |
| 59 | + end if |
| 60 | + |
| 61 | + max_attempts = particle_bed(b)%num_particles*10000 |
| 62 | + n_placed = 0 |
| 63 | + n_attempts = 0 |
| 64 | + seed = particle_bed(b)%seed |
| 65 | + if (seed == 0) seed = 1 + b*1013904223 |
| 66 | + |
| 67 | + allocate (placed(3, particle_bed(b)%num_particles)) |
| 68 | + |
| 69 | + ! Hash table: 4x overprovisioned for ~25% load factor, minimum 16 buckets. |
| 70 | + ! chain_next(i) links placed particle i to the previous occupant of its bucket. |
| 71 | + hash_size = max(16, 4*particle_bed(b)%num_particles) |
| 72 | + allocate (hash_head(hash_size)) |
| 73 | + allocate (chain_next(particle_bed(b)%num_particles)) |
| 74 | + hash_head = -1 |
| 75 | + chain_next = -1 |
| 76 | + |
| 77 | + do while (n_placed < particle_bed(b)%num_particles .and. n_attempts < max_attempts) |
| 78 | + n_attempts = n_attempts + 1 |
| 79 | + |
| 80 | + rx = xmin + f_xorshift(seed)*(xmax - xmin) |
| 81 | + ry = ymin + f_xorshift(seed)*(ymax - ymin) |
| 82 | + if (p == 0) then |
| 83 | + rz = particle_bed(b)%z_centroid |
| 84 | + else |
| 85 | + rz = zmin + f_xorshift(seed)*(zmax - zmin) |
| 86 | + end if |
| 87 | + |
| 88 | + bx = int(floor(rx/min_dist)) |
| 89 | + by = int(floor(ry/min_dist)) |
| 90 | + bz = 0 |
| 91 | + if (p /= 0) bz = int(floor(rz/min_dist)) |
| 92 | + |
| 93 | + ! Check 3x3(x3) neighboring bins — O(1) average via hash lookup |
| 94 | + overlaps = .false. |
| 95 | + outer: do dx_b = -1, 1 |
| 96 | + do dy_b = -1, 1 |
| 97 | + do dz_b = dz_lo, dz_hi |
| 98 | + nbx = bx + dx_b |
| 99 | + nby = by + dy_b |
| 100 | + nbz = bz + dz_b |
| 101 | + slot = f_bin_hash(nbx, nby, nbz, hash_size) |
| 102 | + j = hash_head(slot) |
| 103 | + do while (j > 0) |
| 104 | + if (p == 0) then |
| 105 | + dist = sqrt((rx - placed(1, j))**2 + (ry - placed(2, j))**2) |
| 106 | + else |
| 107 | + dist = sqrt((rx - placed(1, j))**2 + (ry - placed(2, j))**2 & |
| 108 | + + (rz - placed(3, j))**2) |
| 109 | + end if |
| 110 | + if (dist < min_dist) then |
| 111 | + overlaps = .true. |
| 112 | + exit outer |
| 113 | + end if |
| 114 | + j = chain_next(j) |
| 115 | + end do |
| 116 | + end do |
| 117 | + end do |
| 118 | + end do outer |
| 119 | + |
| 120 | + if (.not. overlaps) then |
| 121 | + n_placed = n_placed + 1 |
| 122 | + placed(1, n_placed) = rx |
| 123 | + placed(2, n_placed) = ry |
| 124 | + placed(3, n_placed) = rz |
| 125 | + |
| 126 | + ! Insert into hash grid as head of bucket chain |
| 127 | + slot = f_bin_hash(bx, by, bz, hash_size) |
| 128 | + chain_next(n_placed) = hash_head(slot) |
| 129 | + hash_head(slot) = n_placed |
| 130 | + |
| 131 | + num_ibs = num_ibs + 1 |
| 132 | + ib_idx = num_ibs |
| 133 | + |
| 134 | + patch_ib(ib_idx)%gbl_patch_id = ib_idx |
| 135 | + patch_ib(ib_idx)%geometry = geom |
| 136 | + patch_ib(ib_idx)%x_centroid = rx |
| 137 | + patch_ib(ib_idx)%y_centroid = ry |
| 138 | + patch_ib(ib_idx)%z_centroid = rz |
| 139 | + patch_ib(ib_idx)%radius = particle_bed(b)%radius |
| 140 | + patch_ib(ib_idx)%mass = particle_bed(b)%mass |
| 141 | + patch_ib(ib_idx)%moving_ibm = particle_bed(b)%moving_ibm |
| 142 | + end if |
| 143 | + end do |
| 144 | + |
| 145 | + if (n_placed < particle_bed(b)%num_particles) then |
| 146 | + print '("WARNING: particle_bed(",I0,"): placed ",I0," of ",I0," particles after ",I0," attempts")', & |
| 147 | + b, n_placed, particle_bed(b)%num_particles, n_attempts |
| 148 | + end if |
| 149 | + |
| 150 | + deallocate (placed, hash_head, chain_next) |
| 151 | + end do |
| 152 | + |
| 153 | + end subroutine s_generate_particle_beds |
| 154 | + |
| 155 | + !> Xorshift PRNG. Advances seed in-place and returns a value in [0, 1). |
| 156 | + function f_xorshift(seed) result(rval) |
| 157 | + |
| 158 | + integer, intent(inout) :: seed |
| 159 | + real(wp) :: rval |
| 160 | + |
| 161 | + seed = ieor(seed, ishft(seed, 13)) |
| 162 | + seed = ieor(seed, ishft(seed, -17)) |
| 163 | + seed = ieor(seed, ishft(seed, 5)) |
| 164 | + |
| 165 | + rval = abs(real(seed, wp))/real(huge(seed), wp) |
| 166 | + |
| 167 | + end function f_xorshift |
| 168 | + |
| 169 | + !> Hash bin coordinates to a 1-indexed slot in [1, hash_size]. |
| 170 | + !! Uses large prime multipliers to spread bins across buckets. |
| 171 | + !! Hash collisions are benign: the distance check catches false neighbours. |
| 172 | + function f_bin_hash(bx, by, bz, hash_size) result(slot) |
| 173 | + |
| 174 | + integer, intent(in) :: bx, by, bz, hash_size |
| 175 | + integer :: slot |
| 176 | + integer(8) :: key |
| 177 | + |
| 178 | + key = ieor(ieor(int(bx, 8)*73856093_8, int(by, 8)*19349663_8), int(bz, 8)*83492791_8) |
| 179 | + slot = int(mod(abs(key), int(hash_size, 8))) + 1 |
| 180 | + |
| 181 | + end function f_bin_hash |
| 182 | + |
| 183 | +end module m_particle_bed |
0 commit comments