Skip to content

Commit 58a0cba

Browse files
wilfonbawilfonba
committed
periodic BCs working with non blocking communication
1 parent 69b51ea commit 58a0cba

File tree

2 files changed

+251
-152
lines changed

2 files changed

+251
-152
lines changed

‎src/simulation/m_bubbles_EL.fpp‎

Lines changed: 60 additions & 60 deletions
Original file line numberDiff line numberDiff line change
@@ -79,8 +79,7 @@ module m_bubbles_EL
7979
$:GPU_DECLARE(create='[nBubs,Rmax_glb,Rmin_glb,q_beta,q_beta_idx]')
8080
8181
integer, allocatable, dimension(:) :: keep_bubble, prefix_sum
82-
integer, allocatable, dimension(:) :: wrap_bubble_loc
83-
integer, allocatable, dimension(:,:) :: wrap_bubble_dir
82+
integer, allocatable, dimension(:,:) :: wrap_bubble_loc, wrap_bubble_dir
8483
integer :: active_bubs
8584
$:GPU_DECLARE(create='[keep_bubble, prefix_sum, active_bubs]')
8685
$:GPU_DECLARE(create='[wrap_bubble_loc, wrap_bubble_dir]')
@@ -163,7 +162,7 @@ contains
163162
@:ALLOCATE(mtn_dveldt(1:nBubs_glb, 1:3, 1:lag_num_ts))
164163
165164
@:ALLOCATE(keep_bubble(1:nBubs_glb), prefix_sum(1:nBubs_glb))
166-
@:ALLOCATE(wrap_bubble_loc(1:nBubs_glb), wrap_bubble_dir(1:nBubs_glb, 1:num_dims))
165+
@:ALLOCATE(wrap_bubble_loc(1:nBubs_glb, 1:num_dims), wrap_bubble_dir(1:nBubs_glb, 1:num_dims))
167166
168167
if (adap_dt .and. f_is_default(adap_dt_tol)) adap_dt_tol = dflt_adap_dt_tol
169168
@@ -1380,7 +1379,7 @@ contains
13801379
$:GPU_PARALLEL_LOOP(private='[cell]')
13811380
do k = 1, nBubs
13821381
keep_bubble(k) = 1
1383-
wrap_bubble_loc(k) = 0
1382+
wrap_bubble_loc(k,:) = 0
13841383
wrap_bubble_dir(k,:) = 0
13851384

13861385
! Relocate bubbles at solid boundaries and delete bubbles that leave
@@ -1393,14 +1392,12 @@ contains
13931392
mtn_pos(k, 1, dest) = x_cb(m) - intfc_rad(k, dest)
13941393
elseif (bc_x%beg == BC_PERIODIC .and. mtn_pos(k, 1, dest) < pcomm_coords(1)%beg .and. &
13951394
mtn_posPrev(k, 1, dest) > pcomm_coords(1)%beg) then
1396-
!print*, "1, -1", mtn_pos(k, 1, dest), mtn_posPrev(k, 1, dest), pcomm_coords(1)%beg
13971395
wrap_bubble_dir(k,1) = 1
1398-
wrap_bubble_loc(k) = -1
1396+
wrap_bubble_loc(k,1) = -1
13991397
elseif (bc_x%end == BC_PERIODIC .and. mtn_pos(k, 1, dest) > pcomm_coords(1)%end .and. &
14001398
mtn_posPrev(k, 1, dest) < pcomm_coords(1)%end) then
1401-
!print*, "1, 1", mtn_pos(k, 1, dest), mtn_posPrev(k, 1, dest), pcomm_coords(1)%end
14021399
wrap_bubble_dir(k,1) = 1
1403-
wrap_bubble_loc(k) = 1
1400+
wrap_bubble_loc(k,1) = 1
14041401
elseif (mtn_pos(k, 1, dest) >= x_cb(m + buff_size - fd_number)) then
14051402
keep_bubble(k) = 0
14061403
elseif (mtn_pos(k, 1, dest) < x_cb(fd_number - buff_size - 1)) then
@@ -1415,14 +1412,12 @@ contains
14151412
mtn_pos(k, 2, dest) = y_cb(n) - intfc_rad(k, dest)
14161413
elseif (bc_y%beg == BC_PERIODIC .and. mtn_pos(k, 2, dest) < pcomm_coords(2)%beg .and. &
14171414
mtn_posPrev(k, 2, dest) > pcomm_coords(2)%beg) then
1418-
!print*, "2, -1", mtn_pos(k, 2, dest), mtn_posPrev(k, 2, dest), pcomm_coords(2)%beg
14191415
wrap_bubble_dir(k,2) = 1
1420-
wrap_bubble_loc(k) = -1
1416+
wrap_bubble_loc(k,2) = -1
14211417
elseif (bc_y%end == BC_PERIODIC .and. mtn_pos(k, 2, dest) > pcomm_coords(2)%end .and. &
14221418
mtn_posPrev(k, 2, dest) < pcomm_coords(2)%end) then
1423-
!print*, "2, 1", mtn_pos(k, 2, dest), mtn_posPrev(k, 2, dest), pcomm_coords(2)%end
14241419
wrap_bubble_dir(k,2) = 1
1425-
wrap_bubble_loc(k) = 1
1420+
wrap_bubble_loc(k,2) = 1
14261421
elseif (mtn_pos(k, 2, dest) >= y_cb(n + buff_size - fd_number)) then
14271422
keep_bubble(k) = 0
14281423
elseif (mtn_pos(k, 2, dest) < y_cb(fd_number - buff_size - 1)) then
@@ -1439,11 +1434,11 @@ contains
14391434
elseif (bc_z%beg == BC_PERIODIC .and. mtn_pos(k, 3, dest) < pcomm_coords(3)%beg .and. &
14401435
mtn_posPrev(k, 3, dest) > pcomm_coords(3)%beg) then
14411436
wrap_bubble_dir(k,3) = 1
1442-
wrap_bubble_loc(k) = -1
1437+
wrap_bubble_loc(k,3) = -1
14431438
elseif (bc_z%end == BC_PERIODIC .and. mtn_pos(k, 3, dest) > pcomm_coords(3)%end .and. &
14441439
mtn_posPrev(k, 3, dest) < pcomm_coords(3)%end) then
14451440
wrap_bubble_dir(k,3) = 1
1446-
wrap_bubble_loc(k) = 1
1441+
wrap_bubble_loc(k,3) = 1
14471442
elseif (mtn_pos(k, 3, dest) >= z_cb(p + buff_size - fd_number)) then
14481443
keep_bubble(k) = 0
14491444
elseif (mtn_pos(k, 3, dest) < z_cb(fd_number - buff_size - 1)) then
@@ -1491,52 +1486,57 @@ contains
14911486
& nBubs]')
14921487
call nvtxEndRange
14931488

1494-
! Handle deletion of bubbles leaving local domain
1495-
do k = 1, nBubs
1496-
if (k == 1) then
1497-
prefix_sum(k) = keep_bubble(k)
1498-
else
1499-
prefix_sum(k) = prefix_sum(k - 1) + keep_bubble(k)
1500-
end if
1501-
if (k == nBubs) active_bubs = prefix_sum(k)
1502-
end do
1489+
if (nBubs > 0) then
1490+
! Handle deletion of bubbles leaving local domain
1491+
do k = 1, nBubs
1492+
if (k == 1) then
1493+
prefix_sum(k) = keep_bubble(k)
1494+
else
1495+
prefix_sum(k) = prefix_sum(k - 1) + keep_bubble(k)
1496+
end if
1497+
end do
15031498

1504-
do k = 1, nBubs
1505-
if (keep_bubble(k) == 1) then
1506-
if (prefix_sum(k) /= k) then
1507-
call s_copy_lag_bubble(k, prefix_sum(k))
1499+
active_bubs = prefix_sum(nBubs)
1500+
1501+
do k = 1, nBubs
1502+
if (keep_bubble(k) == 1) then
1503+
if (prefix_sum(k) /= k) then
1504+
call s_copy_lag_bubble(prefix_sum(k), k)
1505+
wrap_bubble_dir(prefix_sum(k), :) = wrap_bubble_dir(k, :)
1506+
wrap_bubble_loc(prefix_sum(k), :) = wrap_bubble_loc(k, :)
1507+
end if
15081508
end if
1509-
end if
1510-
if (k == nBubs) nBubs = active_bubs
1511-
end do
1509+
end do
15121510

1513-
! Handle periodic wrapping of bubbles on same processor
1514-
newBubs = 0
1515-
do k = 1, nBubs
1516-
if (any(wrap_bubble_dir(k, :) == 1)) then
1517-
newBubs = newBubs + 1
1518-
new_idx = nBubs + newBubs
1519-
call s_copy_lag_bubble(k, new_idx)
1520-
do i = 1, num_dims
1521-
if (wrap_bubble_dir(k, i) == 1) then
1522-
offset = glb_bounds(i)%end - glb_bounds(i)%beg
1523-
if (wrap_bubble_loc(k) == 1) then
1524-
do q = 1, 2
1525-
mtn_pos(new_idx, i, q) = mtn_pos(new_idx, i, q) - offset
1526-
mtn_posPrev(new_idx, i, q) = mtn_posPrev(new_idx, i, q) - offset
1527-
end do
1528-
else if (wrap_bubble_loc(k) == -1) then
1529-
do q = 1, 2
1530-
mtn_pos(new_idx, i, q) = mtn_pos(new_idx, i, q) + offset
1531-
mtn_posPrev(new_idx, i, q) = mtn_posPrev(new_idx, i, q) + offset
1532-
end do
1511+
nBubs = active_bubs
1512+
1513+
! Handle periodic wrapping of bubbles on same processor
1514+
newBubs = 0
1515+
do k = 1, nBubs
1516+
if (any(wrap_bubble_dir(k, :) == 1)) then
1517+
newBubs = newBubs + 1
1518+
new_idx = nBubs + newBubs
1519+
call s_copy_lag_bubble(new_idx, k)
1520+
do i = 1, num_dims
1521+
if (wrap_bubble_dir(k, i) == 1) then
1522+
offset = glb_bounds(i)%end - glb_bounds(i)%beg
1523+
if (wrap_bubble_loc(k,i) == 1) then
1524+
do q = 1, 2
1525+
mtn_pos(new_idx, i, q) = mtn_pos(new_idx, i, q) - offset
1526+
mtn_posPrev(new_idx, i, q) = mtn_posPrev(new_idx, i, q) - offset
1527+
end do
1528+
else if (wrap_bubble_loc(k,i) == -1) then
1529+
do q = 1, 2
1530+
mtn_pos(new_idx, i, q) = mtn_pos(new_idx, i, q) + offset
1531+
mtn_posPrev(new_idx, i, q) = mtn_posPrev(new_idx, i, q) + offset
1532+
end do
1533+
end if
15331534
end if
1534-
end if
1535-
end do
1536-
end if
1537-
end do
1538-
print*, nBubs, newBubs
1539-
nBubs = nBubs + newBubs
1535+
end do
1536+
end if
1537+
end do
1538+
nBubs = nBubs + newBubs
1539+
end if
15401540

15411541
! Handle MPI transfer of bubbles going to another processor's local domain
15421542
if (num_procs > 1) then
@@ -1664,7 +1664,7 @@ contains
16641664
end if
16651665
16661666
! 3D
1667-
if (p > 0) then
1667+
if (p > 1) then
16681668
particle_in_domain = ((pos_part(1) < x_cb(m + buff_size - fd_number)) .and. &
16691669
(pos_part(1) >= x_cb(fd_number - buff_size - 1)) .and. &
16701670
(pos_part(2) < y_cb(n + buff_size - fd_number)) .and. &
@@ -2092,7 +2092,7 @@ contains
20922092

20932093
!> The purpose of this subroutine is to remove one specific particle if dt is too small.
20942094
!! @param bub_id Particle id
2095-
impure subroutine s_copy_lag_bubble(src, dest)
2095+
impure subroutine s_copy_lag_bubble(dest, src)
20962096

20972097
integer, intent(in) :: src, dest
20982098

@@ -2110,14 +2110,14 @@ contains
21102110
intfc_vel(dest, 1:2) = intfc_vel(src, 1:2)
21112111
mtn_vel(dest, 1:3, 1:2) = mtn_vel(src, 1:3, 1:2)
21122112
mtn_s(dest, 1:3, 1:2) = mtn_s(src, 1:3, 1:2)
2113+
mtn_pos(dest, 1:3, 1:2) = mtn_pos(src, 1:3, 1:2)
2114+
mtn_posPrev(dest, 1:3, 1:2) = mtn_posPrev(src, 1:3, 1:2)
21132115
intfc_draddt(dest, 1:lag_num_ts) = intfc_draddt(src, 1:lag_num_ts)
21142116
intfc_dveldt(dest, 1:lag_num_ts) = intfc_dveldt(src, 1:lag_num_ts)
21152117
gas_dpdt(dest, 1:lag_num_ts) = gas_dpdt(src, 1:lag_num_ts)
21162118
gas_dmvdt(dest, 1:lag_num_ts) = gas_dmvdt(src, 1:lag_num_ts)
21172119
mtn_dposdt(dest, 1:3, 1:lag_num_ts) = mtn_dposdt(src, 1:3, 1:lag_num_ts)
21182120
mtn_dveldt(dest, 1:3, 1:lag_num_ts) = mtn_dveldt(src, 1:3, 1:lag_num_ts)
2119-
mtn_pos(dest, 1:3, 1:2) = mtn_pos(src, 1:3, 1:2)
2120-
mtn_posPrev(dest, 1:3, 1:2) = mtn_posPrev(src, 1:3, 1:2)
21212121

21222122
end subroutine s_copy_lag_bubble
21232123

0 commit comments

Comments
 (0)