Skip to content

Commit f2dcbaf

Browse files
wilfonbawilfonba
committed
some requested changes and test suite (on CPUs)
1 parent abcdf2f commit f2dcbaf

File tree

9 files changed

+1626
-1634
lines changed

9 files changed

+1626
-1634
lines changed

‎src/common/m_boundary_common.fpp‎

Lines changed: 1359 additions & 1324 deletions
Large diffs are not rendered by default.

‎src/common/m_mpi_common.fpp‎

Lines changed: 255 additions & 31 deletions
Large diffs are not rendered by default.

‎src/pre_process/m_data_output.fpp‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -161,7 +161,7 @@ contains
161161
status = 'new'
162162
end if
163163

164-
if (save_bc) then
164+
if (bc_io) then
165165
call s_write_serial_boundary_condition_files(q_prim_vf, bc_type, t_step_dir)
166166
end if
167167

@@ -864,7 +864,7 @@ contains
864864
end if
865865
#endif
866866

867-
if (save_bc) then
867+
if (bc_io) then
868868
call s_write_parallel_boundary_condition_files(q_prim_vf, bc_type)
869869
end if
870870

‎src/pre_process/m_global_parameters.fpp‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -192,7 +192,7 @@ module m_global_parameters
192192
!! in the module m_derived_types.f90.
193193

194194
integer :: num_bc_patches !< Number of boundary condition patches
195-
logical :: save_bc !< whether or not to save BC data
195+
logical :: bc_io !< whether or not to save BC data
196196
type(bc_patch_parameters), dimension(num_bc_patches_max) :: patch_bc
197197
!! Database of the boundary condition patch parameters for each of the patches
198198
!! employed in the configuration of the boundary conditions
@@ -447,7 +447,7 @@ contains
447447
end do
448448

449449
num_bc_patches = 0
450-
save_bc = .false.
450+
bc_io = .false.
451451

452452
do i = 1, num_bc_patches_max
453453
patch_bc(i)%geometry = dflt_int

‎src/pre_process/m_mpi_proxy.fpp‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -70,7 +70,7 @@ contains
7070
& 'qbmm', 'file_per_process', 'adv_n', 'ib' , 'cfl_adap_dt', &
7171
& 'cfl_const_dt', 'cfl_dt', 'surface_tension', &
7272
& 'hyperelasticity', 'pre_stress', 'elliptic_smoothing', 'viscous',&
73-
& 'bubbles_lagrange', 'save_bc', 'mhd', 'relativity', 'cont_damage' ]
73+
& 'bubbles_lagrange', 'bc_io', 'mhd', 'relativity', 'cont_damage' ]
7474
call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr)
7575
#:endfor
7676
call MPI_BCAST(fluid_rho(1), num_fluids_max, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr)

‎src/pre_process/m_start_up.fpp‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -180,7 +180,7 @@ contains
180180

181181
if (any((/bc_x%beg, bc_x%end, bc_y%beg, bc_y%end, bc_z%beg, bc_z%end/) == -17) .or. &
182182
num_bc_patches > 0) then
183-
save_bc = .true.
183+
bc_io = .true.
184184
end if
185185

186186
else

‎src/simulation/m_global_parameters.fpp‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -189,7 +189,7 @@ module m_global_parameters
189189
!#endif
190190

191191
integer :: num_bc_patches
192-
logical :: read_bc
192+
logical :: bc_io
193193
!> @name Boundary conditions (BC) in the x-, y- and z-directions, respectively
194194
!> @{
195195
type(int_bounds_info) :: bc_x, bc_y, bc_z
@@ -583,7 +583,7 @@ contains
583583
chem_params%gamma_method = 1
584584
585585
num_bc_patches = 0
586-
read_bc = .false.
586+
bc_io = .false.
587587
588588
bc_x%beg = dflt_int; bc_x%end = dflt_int
589589
bc_y%beg = dflt_int; bc_y%end = dflt_int

‎src/simulation/m_mpi_proxy.fpp‎

Lines changed: 1 addition & 266 deletions
Original file line numberDiff line numberDiff line change
@@ -32,16 +32,6 @@ module m_mpi_proxy
3232
3333
implicit none
3434
35-
real(wp), private, allocatable, dimension(:), target :: c_divs_buff_send !<
36-
!! c_divs_buff_send is utilized to send and unpack the buffer of the cell-
37-
!! centered color function derivatives, for a single computational domain
38-
!! boundary at the time, to the the relevant neighboring processor
39-
40-
real(wp), private, allocatable, dimension(:), target :: c_divs_buff_recv
41-
!! c_divs_buff_recv is utilized to receiver and unpack the buffer of the cell-
42-
!! centered color function derivatives, for a single computational domain
43-
!! boundary at the time, from the relevant neighboring processor
44-
4535
integer, private, allocatable, dimension(:), target :: ib_buff_send !<
4636
!! This variable is utilized to pack and send the buffer of the immersed
4737
!! boundary markers, for a single computational domain boundary at the
@@ -61,41 +51,8 @@ module m_mpi_proxy
6151
!> @}
6252
!$acc declare create(v_size)
6353
64-
integer :: nVars !< nVars for surface tension communication
65-
!$acc declare create(nVars)
66-
6754
contains
6855
69-
!> The computation of parameters, the allocation of memory,
70-
!! the association of pointers and/or the execution of any
71-
!! other procedures that are necessary to setup the module.
72-
subroutine s_initialize_mpi_proxy_module
73-
74-
#ifdef MFC_MPI
75-
if (surface_tension) then
76-
nVars = num_dims + 1
77-
if (n > 0) then
78-
if (p > 0) then
79-
@:ALLOCATE(c_divs_buff_send(0:-1 + buff_size*(num_dims+1)* &
80-
& (m + 2*buff_size + 1)* &
81-
& (n + 2*buff_size + 1)* &
82-
& (p + 2*buff_size + 1)/ &
83-
& (min(m, n, p) + 2*buff_size + 1)))
84-
else
85-
@:ALLOCATE(c_divs_buff_send(0:-1 + buff_size*(num_dims+1)* &
86-
& (max(m, n) + 2*buff_size + 1)))
87-
end if
88-
else
89-
@:ALLOCATE(c_divs_buff_send(0:-1 + buff_size*(num_dims+1)))
90-
end if
91-
92-
@:ALLOCATE(c_divs_buff_recv(0:ubound(c_divs_buff_send, 1)))
93-
end if
94-
!$acc update device(v_size, nVars)
95-
#endif
96-
97-
end subroutine s_initialize_mpi_proxy_module
98-
9956
!> Since only the processor with rank 0 reads and verifies
10057
!! the consistency of user inputs, these are initially not
10158
!! available to the other processors. Then, the purpose of
@@ -137,7 +94,7 @@ contains
13794
& 'bc_z%grcbc_in', 'bc_z%grcbc_out', 'bc_z%grcbc_vel_out', &
13895
& 'cfl_adap_dt', 'cfl_const_dt', 'cfl_dt', 'surface_tension', &
13996
& 'viscous', 'shear_stress', 'bulk_stress', 'bubbles_lagrange', &
140-
& 'hyperelasticity', 'rkck_adap_dt', 'read_bc', 'powell', 'cont_damage' ]
97+
& 'hyperelasticity', 'rkck_adap_dt', 'bc_io', 'powell', 'cont_damage' ]
14198
call MPI_BCAST(${VAR}$, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr)
14299
#:endfor
143100
@@ -1658,217 +1615,6 @@ contains
16581615
16591616
end subroutine s_mpi_sendrecv_ib_buffers
16601617
1661-
subroutine s_mpi_sendrecv_capilary_variables_buffers(c_divs_vf, mpi_dir, pbc_loc)
1662-
1663-
type(scalar_field), dimension(num_dims + 1), intent(inout) :: c_divs_vf
1664-
integer, intent(in) :: mpi_dir, pbc_loc
1665-
1666-
integer :: i, j, k, l, r, q !< Generic loop iterators
1667-
1668-
integer :: buffer_counts(1:3), buffer_count
1669-
1670-
type(int_bounds_info) :: boundary_conditions(1:3)
1671-
integer :: beg_end(1:2), grid_dims(1:3)
1672-
integer :: dst_proc, src_proc, recv_tag, send_tag
1673-
1674-
logical :: beg_end_geq_0
1675-
1676-
integer :: pack_offset, unpack_offset
1677-
real(wp), pointer :: p_send, p_recv
1678-
1679-
#ifdef MFC_MPI
1680-
1681-
nVars = num_dims + 1
1682-
!$acc update device(nVars)
1683-
1684-
buffer_counts = (/ &
1685-
buff_size*nVars*(n + 1)*(p + 1), &
1686-
buff_size*nVars*(m + 2*buff_size + 1)*(p + 1), &
1687-
buff_size*nVars*(m + 2*buff_size + 1)*(n + 2*buff_size + 1) &
1688-
/)
1689-
1690-
buffer_count = buffer_counts(mpi_dir)
1691-
boundary_conditions = (/bc_x, bc_y, bc_z/)
1692-
beg_end = (/boundary_conditions(mpi_dir)%beg, boundary_conditions(mpi_dir)%end/)
1693-
beg_end_geq_0 = beg_end(max(pbc_loc, 0) - pbc_loc + 1) >= 0
1694-
1695-
! Implements:
1696-
! pbc_loc bc_x >= 0 -> [send/recv]_tag [dst/src]_proc
1697-
! -1 (=0) 0 -> [1,0] [0,0] | 0 0 [1,0] [beg,beg]
1698-
! -1 (=0) 1 -> [0,0] [1,0] | 0 1 [0,0] [end,beg]
1699-
! +1 (=1) 0 -> [0,1] [1,1] | 1 0 [0,1] [end,end]
1700-
! +1 (=1) 1 -> [1,1] [0,1] | 1 1 [1,1] [beg,end]
1701-
1702-
send_tag = f_logical_to_int(.not. f_xor(beg_end_geq_0, pbc_loc == 1))
1703-
recv_tag = f_logical_to_int(pbc_loc == 1)
1704-
1705-
dst_proc = beg_end(1 + f_logical_to_int(f_xor(pbc_loc == 1, beg_end_geq_0)))
1706-
src_proc = beg_end(1 + f_logical_to_int(pbc_loc == 1))
1707-
1708-
grid_dims = (/m, n, p/)
1709-
1710-
pack_offset = 0
1711-
if (f_xor(pbc_loc == 1, beg_end_geq_0)) then
1712-
pack_offset = grid_dims(mpi_dir) - buff_size + 1
1713-
end if
1714-
1715-
unpack_offset = 0
1716-
if (pbc_loc == 1) then
1717-
unpack_offset = grid_dims(mpi_dir) + buff_size + 1
1718-
end if
1719-
1720-
! Pack Buffer to Send
1721-
#:for mpi_dir in [1, 2, 3]
1722-
if (mpi_dir == ${mpi_dir}$) then
1723-
#:if mpi_dir == 1
1724-
!$acc parallel loop collapse(4) gang vector default(present) private(r)
1725-
do l = 0, p
1726-
do k = 0, n
1727-
do j = 0, buff_size - 1
1728-
do i = 1, nVars
1729-
r = (i - 1) + nVars*(j + buff_size*(k + (n + 1)*l))
1730-
c_divs_buff_send(r) = c_divs_vf(i)%sf(j + pack_offset, k, l)
1731-
end do
1732-
end do
1733-
end do
1734-
end do
1735-
1736-
#:elif mpi_dir == 2
1737-
!$acc parallel loop collapse(4) gang vector default(present) private(r)
1738-
do i = 1, nVars
1739-
do l = 0, p
1740-
do k = 0, buff_size - 1
1741-
do j = -buff_size, m + buff_size
1742-
r = (i - 1) + nVars* &
1743-
((j + buff_size) + (m + 2*buff_size + 1)* &
1744-
(k + buff_size*l))
1745-
c_divs_buff_send(r) = c_divs_vf(i)%sf(j, k + pack_offset, l)
1746-
end do
1747-
end do
1748-
end do
1749-
end do
1750-
1751-
#:else
1752-
!$acc parallel loop collapse(4) gang vector default(present) private(r)
1753-
do i = 1, nVars
1754-
do l = 0, buff_size - 1
1755-
do k = -buff_size, n + buff_size
1756-
do j = -buff_size, m + buff_size
1757-
r = (i - 1) + nVars* &
1758-
((j + buff_size) + (m + 2*buff_size + 1)* &
1759-
((k + buff_size) + (n + 2*buff_size + 1)*l))
1760-
c_divs_buff_send(r) = c_divs_vf(i)%sf(j, k, l + pack_offset)
1761-
end do
1762-
end do
1763-
end do
1764-
end do
1765-
#:endif
1766-
end if
1767-
#:endfor
1768-
1769-
! Send/Recv
1770-
#:for rdma_mpi in [False, True]
1771-
if (rdma_mpi .eqv. ${'.true.' if rdma_mpi else '.false.'}$) then
1772-
p_send => c_divs_buff_send(0)
1773-
p_recv => c_divs_buff_recv(0)
1774-
1775-
#:if rdma_mpi
1776-
!$acc data attach(p_send, p_recv)
1777-
!$acc host_data use_device(p_send, p_recv)
1778-
#:else
1779-
!$acc update host(c_divs_buff_send)
1780-
#:endif
1781-
1782-
call MPI_SENDRECV( &
1783-
p_send, buffer_count, mpi_p, dst_proc, send_tag, &
1784-
p_recv, buffer_count, mpi_p, src_proc, recv_tag, &
1785-
MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr)
1786-
1787-
#:if rdma_mpi
1788-
!$acc end host_data
1789-
!$acc end data
1790-
!$acc wait
1791-
#:else
1792-
!$acc update device(c_divs_buff_recv)
1793-
#:endif
1794-
end if
1795-
#:endfor
1796-
1797-
! Unpack Received Buffer
1798-
#:for mpi_dir in [1, 2, 3]
1799-
if (mpi_dir == ${mpi_dir}$) then
1800-
#:if mpi_dir == 1
1801-
!$acc parallel loop collapse(4) gang vector default(present) private(r)
1802-
do l = 0, p
1803-
do k = 0, n
1804-
do j = -buff_size, -1
1805-
do i = 1, nVars
1806-
r = (i - 1) + nVars* &
1807-
(j + buff_size*((k + 1) + (n + 1)*l))
1808-
c_divs_vf(i)%sf(j + unpack_offset, k, l) = c_divs_buff_recv(r)
1809-
#if defined(__INTEL_COMPILER)
1810-
if (ieee_is_nan(c_divs_vf(i)%sf(j, k, l))) then
1811-
print *, "Error", j, k, l, i
1812-
error stop "NaN(s) in recv"
1813-
end if
1814-
#endif
1815-
end do
1816-
end do
1817-
end do
1818-
end do
1819-
1820-
#:elif mpi_dir == 2
1821-
!$acc parallel loop collapse(4) gang vector default(present) private(r)
1822-
do i = 1, nVars
1823-
do l = 0, p
1824-
do k = -buff_size, -1
1825-
do j = -buff_size, m + buff_size
1826-
r = (i - 1) + nVars* &
1827-
((j + buff_size) + (m + 2*buff_size + 1)* &
1828-
((k + buff_size) + buff_size*l))
1829-
c_divs_vf(i)%sf(j, k + unpack_offset, l) = c_divs_buff_recv(r)
1830-
#if defined(__INTEL_COMPILER)
1831-
if (ieee_is_nan(c_divs_vf(i)%sf(j, k, l))) then
1832-
print *, "Error", j, k, l, i
1833-
error stop "NaN(s) in recv"
1834-
end if
1835-
#endif
1836-
end do
1837-
end do
1838-
end do
1839-
end do
1840-
1841-
#:else
1842-
! Unpacking buffer from bc_z%beg
1843-
!$acc parallel loop collapse(4) gang vector default(present) private(r)
1844-
do i = 1, nVars
1845-
do l = -buff_size, -1
1846-
do k = -buff_size, n + buff_size
1847-
do j = -buff_size, m + buff_size
1848-
r = (i - 1) + nVars* &
1849-
((j + buff_size) + (m + 2*buff_size + 1)* &
1850-
((k + buff_size) + (n + 2*buff_size + 1)* &
1851-
(l + buff_size)))
1852-
c_divs_vf(i)%sf(j, k, l + unpack_offset) = c_divs_buff_recv(r)
1853-
#if defined(__INTEL_COMPILER)
1854-
if (ieee_is_nan(c_divs_vf(i)%sf(j, k, l))) then
1855-
print *, "Error", j, k, l, i
1856-
error stop "NaN(s) in recv"
1857-
end if
1858-
#endif
1859-
end do
1860-
end do
1861-
end do
1862-
end do
1863-
1864-
#:endif
1865-
end if
1866-
#:endfor
1867-
1868-
#endif
1869-
1870-
end subroutine s_mpi_sendrecv_capilary_variables_buffers
1871-
18721618
subroutine s_mpi_send_random_number(phi_rn, num_freq)
18731619
integer, intent(in) :: num_freq
18741620
real(wp), intent(inout), dimension(1:num_freq) :: phi_rn
@@ -1877,15 +1623,4 @@ contains
18771623
#endif
18781624
end subroutine s_mpi_send_random_number
18791625
1880-
!> Module deallocation and/or disassociation procedures
1881-
subroutine s_finalize_mpi_proxy_module
1882-
1883-
#ifdef MFC_MPI
1884-
if (surface_tension) then
1885-
@:DEALLOCATE(c_divs_buff_send, c_divs_buff_recv)
1886-
end if
1887-
#endif
1888-
1889-
end subroutine s_finalize_mpi_proxy_module
1890-
18911626
end module m_mpi_proxy

0 commit comments

Comments
 (0)