program main
use mapl_ComboSpec
use mapl_GathervKernel
use mapl_BW_Benchmark
use mapl_ErrorHandlingMod
use Kernel_mod
use mpi
implicit none
type(ComboSpec) :: spec
integer :: status
call mpi_init(_IERROR)
spec = make_ComboSpec() ! CLI
call run(spec, _RC)
call MPI_Barrier(MPI_COMM_WORLD, _IERROR)
call mpi_finalize(_IERROR)
stop
contains
#undef I_AM_MAIN
#include "MAPL_ErrLog.h"
subroutine run(spec, rc)
type(ComboSpec), intent(in) :: spec
integer, optional, intent(out) :: rc
integer :: status
real :: tot_time
real :: tot_time_write
real :: tot_time_gather
real :: avg_time
real :: avg_time_write
real :: avg_time_gather
type(GathervKernel) :: kernel
type(BW_Benchmark) :: benchmark
integer :: writer_comm
integer :: gather_comm
integer :: i
real :: ta, tb
integer :: color, rank, npes
call MPI_Comm_rank(MPI_COMM_WORLD, rank, _IERROR)
call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR)
color = (rank*spec%n_writers) / npes
call MPI_Comm_split(MPI_COMM_WORLD, color, 0, gather_comm, _IERROR)
call MPI_Comm_rank(gather_comm, rank, _IERROR)
call MPI_Comm_split(MPI_COMM_WORLD, rank, 0, writer_comm, _IERROR)
if (rank /= 0) then
writer_comm = MPI_COMM_NULL
end if
kernel = make_GathervKernel(spec, gather_comm, _RC)
if (rank == 0) then
benchmark = make_BW_Benchmark(spec, writer_comm, _RC)
end if
call write_header(MPI_COMM_WORLD, _RC)
tot_time = 0
tot_time_gather = 0
tot_time_write = 0
associate (n => spec%n_tries)
do i = 1, n
ta = time(kernel, gather_comm, _RC)
if (writer_comm /= MPI_COMM_NULL) then
tb = time(benchmark, writer_comm, _RC)
end if
tot_time_gather = tot_time_gather + ta
tot_time_write = tot_time_write + tb
tot_time = tot_time + ta + tb
end do
avg_time = tot_time / n
avg_time_gather = tot_time_gather / n
avg_time_write = tot_time_write / n
end associate
call report(spec, avg_time, avg_time_gather, avg_time_write, MPI_COMM_WORLD, _RC)
_RETURN(_SUCCESS)
end subroutine run
real function time(kernel, comm, rc)
class(Kernel_T), intent(in) :: kernel
integer, intent(in) :: comm
integer, optional, intent(out) :: rc
integer :: status
real :: t0, t1
call MPI_Barrier(comm, _IERROR)
t0 = MPI_Wtime()
call kernel%run(_RC)
call MPI_Barrier(comm, _IERROR)
t1 = MPI_Wtime()
time = t1 - t0
_RETURN(_SUCCESS)
end function time
subroutine write_header(comm, rc)
integer, intent(in) :: comm
integer, optional, intent(out) :: rc
integer :: status
integer :: rank
call MPI_Comm_rank(comm, rank, _IERROR)
_RETURN_UNLESS(rank == 0)
write(*,'(4(a6,","),4(a15,:,","))',iostat=status) 'NX', '# levs', '# writers', 'group size', 'Time (s)', 'G Time (s)', 'W Time (s)', 'BW (GB/sec)'
_RETURN(status)
end subroutine write_header
subroutine report(spec, avg_time, avg_time_gather, avg_time_write, comm, rc)
type(ComboSpec), intent(in) :: spec
real, intent(in) :: avg_time
real, intent(in) :: avg_time_gather
real, intent(in) :: avg_time_write
integer, intent(in) :: comm
integer, optional, intent(out) :: rc
integer :: status
integer :: rank
integer :: npes
integer :: group
real :: bw_gb
integer, parameter :: WORD=4
call MPI_Comm_rank(comm, rank, _IERROR)
_RETURN_UNLESS(rank == 0)
call MPI_Comm_size(MPI_COMM_WORLD, npes, _IERROR)
group = npes /spec%n_writers
bw_gb = 1.e-9 * WORD * (spec%nx**2)*6*spec%n_levs / avg_time
write(*,'(4(i6.0,","),4(f15.4,:,","))') spec%nx, spec%n_levs, spec%n_writers, group, avg_time, avg_time_gather, avg_time_write, bw_gb
_RETURN(_SUCCESS)
end subroutine report
end program main