Skip to content

Commit a07f9af

Browse files
danieljvickersdanieljvickers
committed
Finished all features, now I need to unbreak test suite
1 parent 9b9975b commit a07f9af

3 files changed

Lines changed: 157 additions & 104 deletions

File tree

‎src/simulation/m_global_parameters.fpp‎

Lines changed: 15 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -337,20 +337,21 @@ module m_global_parameters
337337

338338
!> @name Immersed Boundaries
339339
!> @{
340-
logical :: ib
341-
integer :: num_ibs !< number of IBs that the current processor is aware of
342-
integer :: num_gbl_ibs !< number of IBs in the overall simulation
343-
integer :: num_local_ibs !< number of IBs that lie inside the processor domain
344-
integer :: collision_model
345-
real(wp) :: coefficient_of_restitution
346-
real(wp) :: collision_time
347-
real(wp) :: ib_coefficient_of_friction
348-
logical :: ib_state_wrt
340+
logical :: ib
341+
integer :: num_ibs !< number of IBs that the current processor is aware of
342+
integer :: num_gbl_ibs !< number of IBs in the overall simulation
343+
integer :: num_local_ibs !< number of IBs that lie inside the processor domain
344+
integer :: ib_awareness_radius !< neighborhood radius in ranks (1 = immediate neighbors)
345+
integer :: collision_model
346+
real(wp) :: coefficient_of_restitution
347+
real(wp) :: collision_time
348+
real(wp) :: ib_coefficient_of_friction
349+
logical :: ib_state_wrt
349350
type(ib_patch_parameters), allocatable, dimension(:) :: patch_ib !< Immersed boundary patch parameters
350-
integer, dimension(num_local_ibs_max) :: local_ib_patch_ids !< lookup table of IBs in the local compute domain
351-
integer, dimension(-1:1,-1:1,-1:1) :: ib_neighbor_ranks !< MPI ranks of all 26 neighbor domains
352-
type(vec3_dt), allocatable, dimension(:) :: airfoil_grid_u, airfoil_grid_l
353-
integer :: Np
351+
integer, dimension(num_local_ibs_max) :: local_ib_patch_ids !< lookup table of IBs in the local compute domain
352+
integer, allocatable, dimension(:,:,:) :: ib_neighbor_ranks !< MPI ranks of neighborhood domains, indexed (-N:N,-N:N,-N:N)
353+
type(vec3_dt), allocatable, dimension(:) :: airfoil_grid_u, airfoil_grid_l
354+
integer :: Np
354355

355356
$:GPU_DECLARE(create='[ib, num_ibs, num_gbl_ibs, num_local_ibs, patch_ib, Np, airfoil_grid_u, airfoil_grid_l, local_ib_patch_ids]')
356357
$:GPU_DECLARE(create='[ib_coefficient_of_friction]')
@@ -639,6 +640,7 @@ contains
639640
! Immersed Boundaries
640641
ib = .false.
641642
num_ibs = dflt_int
643+
ib_awareness_radius = 1
642644
collision_model = 0
643645
coefficient_of_restitution = dflt_real
644646
collision_time = dflt_real

‎src/simulation/m_ibm.fpp‎

Lines changed: 36 additions & 60 deletions
Original file line numberDiff line numberDiff line change
@@ -1234,8 +1234,8 @@ contains
12341234
real(wp), dimension(num_ibs, 3), intent(inout) :: forces, torques
12351235
12361236
#ifdef MFC_MPI
1237-
integer :: i, j, pack_pos, unpack_pos, buf_size, ierr
1238-
integer :: send_neighbor, recv_neighbor, recv_count, pid
1237+
integer :: i, j, k, pack_pos, unpack_pos, buf_size, ierr
1238+
integer :: send_neighbor, recv_neighbor, recv_count, pid, tag
12391239
real(wp), dimension(3) :: fval, tval
12401240
real(wp), allocatable :: recv_forces_snap(:,:), recv_torques_snap(:,:)
12411241
character(len=1), allocatable :: send_buf(:), recv_buf(:)
@@ -1246,72 +1246,48 @@ contains
12461246
allocate (send_buf(buf_size), recv_buf(buf_size), recv_forces_snap(num_ibs, 3), recv_torques_snap(num_ibs, 3))
12471247
12481248
! Accumulation phase: propagate contributions toward the high-index corner.
1249-
#:for X, ID, TAG1, TAG2 in [('x', 1, 300, 302), ('y', 2, 304, 306), ('z', 3, 308, 310)]
1249+
#:for X, ID in [('x', 1), ('y', 2), ('z', 3)]
12501250
if (num_dims >= ${ID}$) then
12511251
send_neighbor = merge(bc_${X}$%end, MPI_PROC_NULL, bc_${X}$%end >= 0)
12521252
recv_neighbor = merge(bc_${X}$%beg, MPI_PROC_NULL, bc_${X}$%beg >= 0)
12531253
1254-
! Pass 1: send current forces to +${X}$ neighbor; receive from -${X}$ neighbor and add. Save what was received as
1255-
! recv_snap for double-count removal in pass 2.
12561254
recv_forces_snap = 0._wp
12571255
recv_torques_snap = 0._wp
1258-
pack_pos = 0
1259-
call MPI_PACK(num_ibs, 1, MPI_INTEGER, send_buf, buf_size, pack_pos, MPI_COMM_WORLD, ierr)
1260-
do i = 1, num_ibs
1261-
call MPI_PACK(patch_ib(i)%gbl_patch_id, 1, MPI_INTEGER, send_buf, buf_size, pack_pos, MPI_COMM_WORLD, ierr)
1262-
fval(:) = forces(i,:); tval(:) = torques(i,:)
1263-
call MPI_PACK(fval, 3, mpi_p, send_buf, buf_size, pack_pos, MPI_COMM_WORLD, ierr)
1264-
call MPI_PACK(tval, 3, mpi_p, send_buf, buf_size, pack_pos, MPI_COMM_WORLD, ierr)
1265-
end do
1266-
call MPI_SENDRECV(send_buf, pack_pos, MPI_PACKED, send_neighbor, ${TAG1}$, recv_buf, buf_size, MPI_PACKED, &
1267-
& recv_neighbor, ${TAG1}$, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
1268-
if (recv_neighbor /= MPI_PROC_NULL) then
1269-
unpack_pos = 0
1270-
call MPI_UNPACK(recv_buf, buf_size, unpack_pos, recv_count, 1, MPI_INTEGER, MPI_COMM_WORLD, ierr)
1271-
do i = 1, recv_count
1272-
call MPI_UNPACK(recv_buf, buf_size, unpack_pos, pid, 1, MPI_INTEGER, MPI_COMM_WORLD, ierr)
1273-
call MPI_UNPACK(recv_buf, buf_size, unpack_pos, fval, 3, mpi_p, MPI_COMM_WORLD, ierr)
1274-
call MPI_UNPACK(recv_buf, buf_size, unpack_pos, tval, 3, mpi_p, MPI_COMM_WORLD, ierr)
1275-
do j = 1, num_ibs
1276-
if (patch_ib(j)%gbl_patch_id == pid) then
1277-
recv_forces_snap(j,:) = fval(:)
1278-
recv_torques_snap(j,:) = tval(:)
1279-
forces(j,:) = forces(j,:) + fval(:)
1280-
torques(j,:) = torques(j,:) + tval(:)
1281-
exit
1282-
end if
1283-
end do
1284-
end do
1285-
end if
1256+
tag = 300
12861257
1287-
! Pass 2: send post-pass-1 forces to +${X}$ neighbor; receive from -${X}$ neighbor. Add received values then
1288-
! subtract recv_snap to remove the pass-1 contribution that was already counted, leaving only the 2-hop delta.
1289-
pack_pos = 0
1290-
call MPI_PACK(num_ibs, 1, MPI_INTEGER, send_buf, buf_size, pack_pos, MPI_COMM_WORLD, ierr)
1291-
do i = 1, num_ibs
1292-
call MPI_PACK(patch_ib(i)%gbl_patch_id, 1, MPI_INTEGER, send_buf, buf_size, pack_pos, MPI_COMM_WORLD, ierr)
1293-
fval(:) = forces(i,:); tval(:) = torques(i,:)
1294-
call MPI_PACK(fval, 3, mpi_p, send_buf, buf_size, pack_pos, MPI_COMM_WORLD, ierr)
1295-
call MPI_PACK(tval, 3, mpi_p, send_buf, buf_size, pack_pos, MPI_COMM_WORLD, ierr)
1296-
end do
1297-
call MPI_SENDRECV(send_buf, pack_pos, MPI_PACKED, send_neighbor, ${TAG2}$, recv_buf, buf_size, MPI_PACKED, &
1298-
& recv_neighbor, ${TAG2}$, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
1299-
if (recv_neighbor /= MPI_PROC_NULL) then
1300-
unpack_pos = 0
1301-
call MPI_UNPACK(recv_buf, buf_size, unpack_pos, recv_count, 1, MPI_INTEGER, MPI_COMM_WORLD, ierr)
1302-
do i = 1, recv_count
1303-
call MPI_UNPACK(recv_buf, buf_size, unpack_pos, pid, 1, MPI_INTEGER, MPI_COMM_WORLD, ierr)
1304-
call MPI_UNPACK(recv_buf, buf_size, unpack_pos, fval, 3, mpi_p, MPI_COMM_WORLD, ierr)
1305-
call MPI_UNPACK(recv_buf, buf_size, unpack_pos, tval, 3, mpi_p, MPI_COMM_WORLD, ierr)
1306-
do j = 1, num_ibs
1307-
if (patch_ib(j)%gbl_patch_id == pid) then
1308-
forces(j,:) = forces(j,:) + fval(:) - recv_forces_snap(j,:)
1309-
torques(j,:) = torques(j,:) + tval(:) - recv_torques_snap(j,:)
1310-
exit
1311-
end if
1312-
end do
1258+
do k = 1, (2*ib_awareness_radius) - 1
1259+
! send forces to +${X}$ neighbor; receive from -${X}$ neighbor. Add received values then
1260+
pack_pos = 0
1261+
call MPI_PACK(num_ibs, 1, MPI_INTEGER, send_buf, buf_size, pack_pos, MPI_COMM_WORLD, ierr)
1262+
do i = 1, num_ibs
1263+
call MPI_PACK(patch_ib(i)%gbl_patch_id, 1, MPI_INTEGER, send_buf, buf_size, pack_pos, MPI_COMM_WORLD, ierr)
1264+
fval(:) = forces(i,:); tval(:) = torques(i,:)
1265+
call MPI_PACK(fval, 3, mpi_p, send_buf, buf_size, pack_pos, MPI_COMM_WORLD, ierr)
1266+
call MPI_PACK(tval, 3, mpi_p, send_buf, buf_size, pack_pos, MPI_COMM_WORLD, ierr)
13131267
end do
1314-
end if
1268+
call MPI_SENDRECV(send_buf, pack_pos, MPI_PACKED, send_neighbor, tag, recv_buf, buf_size, MPI_PACKED, &
1269+
& recv_neighbor, tag, MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
1270+
if (recv_neighbor /= MPI_PROC_NULL) then
1271+
unpack_pos = 0
1272+
call MPI_UNPACK(recv_buf, buf_size, unpack_pos, recv_count, 1, MPI_INTEGER, MPI_COMM_WORLD, ierr)
1273+
do i = 1, recv_count
1274+
call MPI_UNPACK(recv_buf, buf_size, unpack_pos, pid, 1, MPI_INTEGER, MPI_COMM_WORLD, ierr)
1275+
call MPI_UNPACK(recv_buf, buf_size, unpack_pos, fval, 3, mpi_p, MPI_COMM_WORLD, ierr)
1276+
call MPI_UNPACK(recv_buf, buf_size, unpack_pos, tval, 3, mpi_p, MPI_COMM_WORLD, ierr)
1277+
do j = 1, num_ibs
1278+
if (patch_ib(j)%gbl_patch_id == pid) then
1279+
! add forces and subtract recv_snap prevent double-counting
1280+
forces(j,:) = forces(j,:) + fval(:) - recv_forces_snap(j,:)
1281+
torques(j,:) = torques(j,:) + tval(:) - recv_torques_snap(j,:)
1282+
recv_forces_snap(j,:) = fval(:)
1283+
recv_torques_snap(j,:) = tval(:)
1284+
exit
1285+
end if
1286+
end do
1287+
end do
1288+
end if
1289+
tag = tag + 2
1290+
end do
13151291
end if
13161292
#:endfor
13171293

0 commit comments

Comments
 (0)