@@ -20,14 +20,17 @@ module m_collisions
2020 implicit none
2121
2222 private; public :: s_apply_collision_forces, s_initialize_collisions_module, s_finalize_collisions_module, &
23- & f_local_rank_owns_location, f_neighborhood_ranks_own_location
23+ & f_local_rank_owns_location, f_neighborhood_ranks_own_location, ib_gbl_idx_lookup
2424 ! overlap distances for computing collisions
2525 integer , allocatable, dimension (:,:) :: collision_lookup
2626 real (wp), allocatable, dimension (:,:) :: wall_overlap_distances
2727 real (wp) :: spring_stiffness, damping_parameter
2828 $:GPU_DECLARE(create= ' [spring_stiffness, damping_parameter]' )
2929 $:GPU_DECLARE(create= ' [collision_lookup, wall_overlap_distances]' )
3030
31+ integer , dimension (:), allocatable :: ib_gbl_idx_lookup
32+ $:GPU_DECLARE(create= ' [ib_gbl_idx_lookup]' )
33+
3134contains
3235
3336 subroutine s_initialize_collisions_module ()
@@ -99,6 +102,9 @@ contains
99102 encoded_pid2 = collision_lookup(i, 4 )
100103 call s_decode_patch_periodicity(encoded_pid1, pid1, xp1, yp1, zp1)
101104 call s_decode_patch_periodicity(encoded_pid2, pid2, xp2, yp2, zp2)
105+ pid1 = collision_lookup(i, 1 )
106+ pid2 = collision_lookup(i, 2 )
107+
102108 ! call s_get_neighborhood_idx(pid1, pid1) ! global patch ID - > local index call s_get_neighborhood_idx(pid2, pid2)
103109 if (pid1 <= 0 .or. pid2 <= 0 ) cycle
104110
@@ -291,6 +297,8 @@ contains
291297 ! get the decoded pairs for checking if they exist, using ii,jj,kk as dummy indices
292298 call s_decode_patch_periodicity(raw_pairs(pair_idx, 1 ), decoded_pairs(1 ), ii, jj, kk)
293299 call s_decode_patch_periodicity(raw_pairs(pair_idx, 2 ), decoded_pairs(2 ), ii, jj, kk)
300+ decoded_pairs(1 ) = ib_gbl_idx_lookup(decoded_pairs(1 ))
301+ decoded_pairs(2 ) = ib_gbl_idx_lookup(decoded_pairs(2 ))
294302
295303 ! skip self- collisions (an IB cannot collide with its own periodic image)
296304 if (decoded_pairs(1 ) == decoded_pairs(2 )) cycle
@@ -329,34 +337,46 @@ contains
329337 subroutine s_detect_ib_collisions_n2 (num_considered_collisions )
330338
331339 integer , intent (out ) :: num_considered_collisions
332- integer :: pid1, pid2, encoded_pid1, encoded_pid2, current_collisions
340+ integer :: pid1, pid2, encoded_pid2, current_collisions
341+ integer :: xp_lower, xp_upper, yp_lower, yp_upper, zp_lower, zp_upper, xp, yp, zp
333342 real (wp), dimension (3 ) :: centroid_1, centroid_2, distance_vec
334343
335344 num_considered_collisions = 0
336345
337- $:GPU_PARALLEL_LOOP(private= ' [pid1, pid2, centroid_1, centroid_2, distance_vec, current_collisions]' , &
338- & copy= ' [num_considered_collisions]' )
346+ call s_get_periodicities(xp_lower, xp_upper, yp_lower, yp_upper, zp_lower, zp_upper)
347+
348+ $:GPU_PARALLEL_LOOP(private= ' [pid1, pid2, encoded_pid2, centroid_1, centroid_2, xp, yp, zp, distance_vec, &
349+ & current_collisions]' , copyin= ' [xp_lower, xp_upper, yp_lower, yp_upper, zp_lower, zp_upper]' , copy= ' [num_considered_collisions]' )
339350 do pid1 = 1 , num_ibs - 1
351+ centroid_1 = [patch_ib(pid1)%x_centroid, patch_ib(pid1)%y_centroid, 0._wp ]
352+ if (num_dims == 3 ) centroid_1(3 ) = patch_ib(pid1)%z_centroid
340353 do pid2 = pid1 + 1 , num_ibs
341- centroid_1 = [patch_ib(pid1)%x_centroid, patch_ib(pid1)%y_centroid, 0._wp ]
342- centroid_2 = [patch_ib(pid2)%x_centroid, patch_ib(pid2)%y_centroid, 0._wp ]
343- if (num_dims == 3 ) then
344- centroid_1(3 ) = patch_ib(pid1)%z_centroid
345- centroid_2(3 ) = patch_ib(pid2)%z_centroid
346- end if
347- distance_vec = centroid_2 - centroid_1
348-
349- if (norm2(distance_vec) < patch_ib(pid1)%radius + patch_ib(pid2)%radius) then
350- $:GPU_ATOMIC(atomic= ' capture' )
351- num_considered_collisions = num_considered_collisions + 1
352- current_collisions = num_considered_collisions
353- $:END_GPU_ATOMIC_CAPTURE()
354-
355- collision_lookup(current_collisions, 1 ) = pid1
356- collision_lookup(current_collisions, 2 ) = pid2
357- collision_lookup(current_collisions, 3 ) = pid1
358- collision_lookup(current_collisions, 4 ) = pid2
359- end if
354+ periodic_search: do xp = xp_lower, xp_upper
355+ do yp = yp_lower, yp_upper
356+ do zp = zp_lower, zp_upper
357+ centroid_2(1 ) = patch_ib(pid2)%x_centroid + real (xp, wp)* (x_domain%end - x_domain%beg)
358+ centroid_2(2 ) = patch_ib(pid2)%y_centroid + real (yp, wp)* (y_domain%end - y_domain%beg)
359+ if (num_dims == 3 ) centroid_2(3 ) = patch_ib(pid2)%z_centroid + real (zp, &
360+ & wp)* (z_domain%end - z_domain%beg)
361+ distance_vec = centroid_2 - centroid_1
362+
363+ if (norm2(distance_vec) < patch_ib(pid1)%radius + patch_ib(pid2)%radius) then
364+ $:GPU_ATOMIC(atomic= ' capture' )
365+ num_considered_collisions = num_considered_collisions + 1
366+ current_collisions = num_considered_collisions
367+ $:END_GPU_ATOMIC_CAPTURE()
368+
369+ call s_encode_patch_periodicity(patch_ib(pid2)%gbl_patch_id, xp, yp, zp, encoded_pid2)
370+
371+ collision_lookup(current_collisions, 1 ) = pid1
372+ collision_lookup(current_collisions, 2 ) = pid2
373+ collision_lookup(current_collisions, 3 ) = patch_ib(pid1)%gbl_patch_id
374+ collision_lookup(current_collisions, 4 ) = encoded_pid2
375+ exit periodic_search
376+ end if
377+ end do
378+ end do
379+ end do periodic_search
360380 end do
361381 end do
362382 $:END_GPU_PARALLEL_LOOP()
0 commit comments