Skip to content

Commit

Permalink
indent
Browse files Browse the repository at this point in the history
  • Loading branch information
@sbryngelson
sbryngelson committed Jan 28, 2023
1 parent 847580b commit a348e9f
Show file tree
Hide file tree
Showing 4 changed files with 659 additions and 47 deletions.
183 changes: 183 additions & 0 deletions post.f90
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,183 @@
subroutine s_mpi_decompose_computational_domain() ! --------------------

#ifdef MFC_MPI

integer :: num_procs_x, num_procs_y

real(kind(0d0)) :: tmp_num_procs_x, tmp_num_procs_y

real(kind(0d0)) :: fct_min

integer :: MPI_COMM_CART

integer :: rem_cells

integer :: i

if (num_procs == 1 .and. parallel_io) then
do i = 1, num_dims
start_idx(i) = 0
end do
return
end if

if (n > 0) then

num_procs_x = 1
num_procs_y = num_procs
ierr = -1

! Benchmarking the quality of this initial guess
tmp_num_procs_x = num_procs_x
tmp_num_procs_y = num_procs_y
fct_min = 10d0*abs((m + 1)/tmp_num_procs_x &
- (n + 1)/tmp_num_procs_y)

do i = 1, num_procs

if (mod(num_procs, i) == 0 &
.and. &
(m + 1)/i >= num_stcls_min*weno_order) then

tmp_num_procs_x = i
tmp_num_procs_y = num_procs/i

if (fct_min >= abs((m + 1)/tmp_num_procs_x &
- (n + 1)/tmp_num_procs_y) &
.and. &
(n + 1)/tmp_num_procs_y &
>= &
num_stcls_min*weno_order) then

num_procs_x = i
num_procs_y = num_procs/i
fct_min = abs((m + 1)/tmp_num_procs_x &
- (n + 1)/tmp_num_procs_y)
ierr = 0

end if

end if

end do

! Verifying that a valid decomposition of the computational
! domain has been established. If not, the simulation exits.
if (proc_rank == 0 .and. ierr == -1) then
print '(A)', 'Unsupported combination of values '// &
'of num_procs, m, n and '// &
'weno_order. Exiting ...'
call MPI_ABORT(MPI_COMM_WORLD, 1, ierr)
end if

call MPI_CART_CREATE(MPI_COMM_WORLD, 2, (/num_procs_x, &
num_procs_y/), (/.true., &
.true./), .false., MPI_COMM_CART, &
ierr)

! Finding the Cartesian coordinates of the local process
call MPI_CART_COORDS(MPI_COMM_CART, proc_rank, 2, &
proc_coords, ierr)


! Global Parameters for y-direction ================================

! Number of remaining cells
rem_cells = mod(n + 1, num_procs_y)

! Optimal number of cells per processor
n = (n + 1)/num_procs_y - 1

! Distributing the remaining cells
do i = 1, rem_cells
if (proc_coords(2) == i - 1) then
n = n + 1; exit
end if
end do

! Boundary condition at the beginning
if (proc_coords(2) > 0 .or. bc_y%beg == -1) then
proc_coords(2) = proc_coords(2) - 1
call MPI_CART_RANK(MPI_COMM_CART, proc_coords, &
bc_y%beg, ierr)
proc_coords(2) = proc_coords(2) + 1
end if

! Boundary condition at the end
if (proc_coords(2) < num_procs_y - 1 .or. bc_y%end == -1) then
proc_coords(2) = proc_coords(2) + 1
call MPI_CART_RANK(MPI_COMM_CART, proc_coords, &
bc_y%end, ierr)
proc_coords(2) = proc_coords(2) - 1
end if

if (parallel_io) then
if (proc_coords(2) < rem_cells) then
start_idx(2) = (n + 1)*proc_coords(2)
else
start_idx(2) = (n + 1)*proc_coords(2) + rem_cells
end if
end if
! ==================================================================

else

num_procs_x = num_procs

call MPI_CART_CREATE(MPI_COMM_WORLD, 1, (/num_procs_x/), &
(/.true./), .false., MPI_COMM_CART, &
ierr)

! Finding the Cartesian coordinates of the local process
call MPI_CART_COORDS(MPI_COMM_CART, proc_rank, 1, &
proc_coords, ierr)

end if
! ==================================================================

! Global Parameters for x-direction ================================

! Number of remaining cells
rem_cells = mod(m + 1, num_procs_x)

! Optimal number of cells per processor
m = (m + 1)/num_procs_x - 1

! Distributing the remaining cells
do i = 1, rem_cells
if (proc_coords(1) == i - 1) then
m = m + 1; exit
end if
end do

! Boundary condition at the beginning
if (proc_coords(1) > 0 .or. bc_x%beg == -1) then
proc_coords(1) = proc_coords(1) - 1
call MPI_CART_RANK(MPI_COMM_CART, proc_coords, bc_x%beg, ierr)
proc_coords(1) = proc_coords(1) + 1
end if

! Boundary condition at the end
if (proc_coords(1) < num_procs_x - 1 .or. bc_x%end == -1) then
proc_coords(1) = proc_coords(1) + 1
call MPI_CART_RANK(MPI_COMM_CART, proc_coords, bc_x%end, ierr)
proc_coords(1) = proc_coords(1) - 1
end if

if (parallel_io) then
if (proc_coords(1) < rem_cells) then
start_idx(1) = (m + 1)*proc_coords(1)
else
start_idx(1) = (m + 1)*proc_coords(1) + rem_cells
end if
end if
! ==================================================================

if (proc_rank == 0) then
print *, m, n
end if

#endif

end subroutine s_mpi_decompose_computational_domain ! ------------------

208 changes: 208 additions & 0 deletions pre.f90
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,208 @@
subroutine s_mpi_decompose_computational_domain() ! --------------------

#ifdef MFC_MPI

integer :: num_procs_x, num_procs_y

real(kind(0d0)) :: tmp_num_procs_x, tmp_num_procs_y

real(kind(0d0)) :: fct_min

integer :: MPI_COMM_CART

integer :: rem_cells

integer :: i

if (num_procs == 1 .and. parallel_io) then
do i = 1, num_dims
start_idx(i) = 0
end do
return
end if

if (n > 0) then

! Initial values of the processor factorization optimization
num_procs_x = 1
num_procs_y = num_procs
ierr = -1

! Computing minimization variable for these initial values
tmp_num_procs_x = num_procs_x
tmp_num_procs_y = num_procs_y
fct_min = 10d0*abs((m + 1)/tmp_num_procs_x &
- (n + 1)/tmp_num_procs_y)

! Searching for optimal computational domain distribution
do i = 1, num_procs

if (mod(num_procs, i) == 0 &
.and. &
(m + 1)/i >= num_stcls_min*weno_order) then

tmp_num_procs_x = i
tmp_num_procs_y = num_procs/i

if (fct_min >= abs((m + 1)/tmp_num_procs_x &
- (n + 1)/tmp_num_procs_y) &
.and. &
(n + 1)/tmp_num_procs_y &
>= &
num_stcls_min*weno_order) then

num_procs_x = i
num_procs_y = num_procs/i
fct_min = abs((m + 1)/tmp_num_procs_x &
- (n + 1)/tmp_num_procs_y)
ierr = 0

end if

end if

end do

! Checking whether the decomposition of the computational
! domain was successful
if (proc_rank == 0 .and. ierr == -1) then
print '(A)', 'Unable to decompose computational '// &
'domain for selected number of '// &
'processors. Exiting ...'
call MPI_ABORT(MPI_COMM_WORLD, 1, ierr)
end if

! Creating a new communicator using Cartesian topology
call MPI_CART_CREATE(MPI_COMM_WORLD, 2, (/num_procs_x, &
num_procs_y/), (/.true., &
.true./), .false., MPI_COMM_CART, &
ierr)

! Finding corresponding Cartesian coordinates of the local
! processor rank in newly declared cartesian communicator
call MPI_CART_COORDS(MPI_COMM_CART, proc_rank, 2, &
proc_coords, ierr)


! END: Generating 2D Cartesian Processor Topology ==================

! Sub-domain Global Parameters in y-direction ======================

! Number of remaining cells after majority has been distributed
rem_cells = mod(n + 1, num_procs_y)

! Preliminary uniform cell-width spacing
if (old_grid .neqv. .true.) then
dy = (y_domain%end - y_domain%beg)/real(n + 1, kind(0d0))
end if

! Optimal number of cells per processor
n = (n + 1)/num_procs_y - 1

! Distributing any remaining cells
do i = 1, rem_cells
if (proc_coords(2) == i - 1) then
n = n + 1
exit
end if
end do

! Beginning and end sub-domain boundary locations
if (parallel_io .neqv. .true.) then
if (old_grid .neqv. .true.) then
if (proc_coords(2) < rem_cells) then
y_domain%beg = y_domain%beg + dy*real((n + 1)* &
proc_coords(2))
y_domain%end = y_domain%end - dy*real((n + 1)* &
(num_procs_y - proc_coords(2) - 1) &
- (num_procs_y - rem_cells))
else
y_domain%beg = y_domain%beg + dy*real((n + 1)* &
proc_coords(2) + rem_cells)
y_domain%end = y_domain%end - dy*real((n + 1)* &
(num_procs_y - proc_coords(2) - 1))
end if
end if
else
if (proc_coords(2) < rem_cells) then
start_idx(2) = (n + 1)*proc_coords(2)
else
start_idx(2) = (n + 1)*proc_coords(2) + rem_cells
end if
end if

! ==================================================================

! Generating 1D Cartesian Processor Topology =======================

else

! Number of processors in the coordinate direction is equal to
! the total number of processors available
num_procs_x = num_procs

! Creating a new communicator using Cartesian topology
call MPI_CART_CREATE(MPI_COMM_WORLD, 1, (/num_procs_x/), &
(/.true./), .false., MPI_COMM_CART, &
ierr)

! Finding the corresponding Cartesian coordinates of the local
! processor rank in the newly declared cartesian communicator
call MPI_CART_COORDS(MPI_COMM_CART, proc_rank, 1, &
proc_coords, ierr)

end if

! ==================================================================

! Sub-domain Global Parameters in x-direction ======================

! Number of remaining cells after majority has been distributed
rem_cells = mod(m + 1, num_procs_x)

! Preliminary uniform cell-width spacing
if (old_grid .neqv. .true.) then
dx = (x_domain%end - x_domain%beg)/real(m + 1, kind(0d0))
end if

! Optimal number of cells per processor
m = (m + 1)/num_procs_x - 1

! Distributing any remaining cells
do i = 1, rem_cells
if (proc_coords(1) == i - 1) then
m = m + 1
exit
end if
end do

! Beginning and end sub-domain boundary locations
if (parallel_io .neqv. .true.) then
if (old_grid .neqv. .true.) then
if (proc_coords(1) < rem_cells) then
x_domain%beg = x_domain%beg + dx*real((m + 1)* &
proc_coords(1))
x_domain%end = x_domain%end - dx*real((m + 1)* &
(num_procs_x - proc_coords(1) - 1) &
- (num_procs_x - rem_cells))
else
x_domain%beg = x_domain%beg + dx*real((m + 1)* &
proc_coords(1) + rem_cells)
x_domain%end = x_domain%end - dx*real((m + 1)* &
(num_procs_x - proc_coords(1) - 1))
end if
end if
else
if (proc_coords(1) < rem_cells) then
start_idx(1) = (m + 1)*proc_coords(1)
else
start_idx(1) = (m + 1)*proc_coords(1) + rem_cells
end if
end if

! ==================================================================


#endif

end subroutine s_mpi_decompose_computational_domain ! ------------------
Loading

0 comments on commit a348e9f

Please sign in to comment.