main Program

Uses

  • program~~main~6~~UsesGraph program~main~6 main iso_fortran_env iso_fortran_env program~main~6->iso_fortran_env module~mapl_bw_benchmark mapl_BW_Benchmark program~main~6->module~mapl_bw_benchmark module~mapl_bw_benchmarkspec mapl_BW_BenchmarkSpec program~main~6->module~mapl_bw_benchmarkspec module~mapl_errorhandlingmod MAPL_ErrorHandlingMod program~main~6->module~mapl_errorhandlingmod mpi mpi program~main~6->mpi module~mapl_bw_benchmark->iso_fortran_env module~mapl_bw_benchmark->module~mapl_errorhandlingmod module~kernel_mod Kernel_mod module~mapl_bw_benchmark->module~kernel_mod module~mapl_bw_benchmarkspec->iso_fortran_env module~mapl_bw_benchmarkspec->module~mapl_bw_benchmark module~mapl_bw_benchmarkspec->module~mapl_errorhandlingmod module~mapl_bw_benchmarkspec->mpi fArgParse fArgParse module~mapl_bw_benchmarkspec->fArgParse module~mapl_errorhandlingmod->mpi module~mapl_throwmod MAPL_ThrowMod module~mapl_errorhandlingmod->module~mapl_throwmod

Calls

program~~main~6~~CallsGraph program~main~6 main mpi_barrier mpi_barrier program~main~6->mpi_barrier mpi_finalize mpi_finalize program~main~6->mpi_finalize mpi_init mpi_init program~main~6->mpi_init proc~make_bw_benchmarkspec make_BW_BenchmarkSpec program~main~6->proc~make_bw_benchmarkspec proc~mapl_abort MAPL_abort program~main~6->proc~mapl_abort proc~mapl_verify MAPL_Verify program~main~6->proc~mapl_verify proc~run~8 run program~main~6->proc~run~8 proc~make_bw_benchmarkspec->proc~mapl_verify add_argument add_argument proc~make_bw_benchmarkspec->add_argument argparser argparser proc~make_bw_benchmarkspec->argparser at at proc~make_bw_benchmarkspec->at cast cast proc~make_bw_benchmarkspec->cast interface~mapl_assert MAPL_Assert proc~make_bw_benchmarkspec->interface~mapl_assert parse_args parse_args proc~make_bw_benchmarkspec->parse_args proc~mapl_return MAPL_Return proc~make_bw_benchmarkspec->proc~mapl_return mpi_abort mpi_abort proc~mapl_abort->mpi_abort proc~mapl_throw_exception MAPL_throw_exception proc~mapl_verify->proc~mapl_throw_exception proc~run~8->proc~mapl_verify mpi_comm_rank mpi_comm_rank proc~run~8->mpi_comm_rank mpi_comm_size mpi_comm_size proc~run~8->mpi_comm_size mpi_comm_split mpi_comm_split proc~run~8->mpi_comm_split proc~make_bw_benchmark~2 make_BW_Benchmark proc~run~8->proc~make_bw_benchmark~2 proc~run~8->proc~mapl_return proc~report report proc~run~8->proc~report proc~write_header write_header proc~run~8->proc~write_header proc~make_bw_benchmark~2->proc~mapl_verify proc~make_bw_benchmark~2->mpi_comm_rank proc~make_bw_benchmark~2->proc~mapl_return proc~mapl_return->at proc~mapl_return->proc~mapl_throw_exception insert insert proc~mapl_return->insert proc~report->proc~mapl_verify proc~report->mpi_comm_rank proc~report->mpi_comm_size proc~report->proc~mapl_return proc~write_header->proc~mapl_verify proc~write_header->mpi_comm_rank proc~write_header->proc~mapl_return

Variables

Type Attributes Name Initial
integer :: status
type(BW_BenchmarkSpec) :: spec

Functions

function time(benchmark, comm, rc)

Arguments

Type IntentOptional Attributes Name
type(BW_Benchmark), intent(in) :: benchmark
integer, intent(in) :: comm
integer, intent(out), optional :: rc

Return Value real


Subroutines

subroutine report(spec, avg_time, std_time, comm, rc)

Arguments

Type IntentOptional Attributes Name
type(BW_BenchmarkSpec), intent(in) :: spec
real, intent(in) :: avg_time
real, intent(in) :: std_time
integer, intent(in) :: comm
integer, intent(out), optional :: rc

subroutine run(spec, rc)

Arguments

Type IntentOptional Attributes Name
type(BW_BenchmarkSpec), intent(in) :: spec
integer, intent(out), optional :: rc

subroutine write_header(comm, rc)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: comm
integer, intent(out), optional :: rc

Source Code

program main
   use mapl_BW_BenchmarkSpec
   use mapl_BW_Benchmark
   use mapl_ErrorHandlingMod
   use mpi
   use, intrinsic :: iso_fortran_env, only: INT64
   implicit none

   type(BW_BenchmarkSpec) :: spec
   integer :: status
      
   call mpi_init(status)
   _VERIFY(status)
   spec = make_BW_BenchmarkSpec() ! CLI

   call run(spec, _RC)

   call MPI_Barrier(MPI_COMM_WORLD, status)
   _VERIFY(status)
   call mpi_finalize(status)
   stop


contains


#undef I_AM_MAIN
#include "MAPL_ErrLog.h"
   subroutine run(spec, rc)
      type(BW_BenchmarkSpec), intent(in) :: spec
      integer, optional, intent(out) :: rc

      integer :: status

      real :: tot_time
      real :: tot_time_sq
      real :: avg_time
      real :: std_time
      type(BW_Benchmark) :: benchmark
      integer :: writer_comm
      integer :: gather_comm
      integer :: i
      real :: t

      integer :: color, rank, npes
      call MPI_Comm_rank(MPI_COMM_WORLD, rank, status)
      _VERIFY(status)
      call MPI_Comm_size(MPI_COMM_WORLD, npes, status)
      _VERIFY(status)

      color = (rank*spec%n_writers) / npes
      call MPI_Comm_split(MPI_COMM_WORLD, color, 0, gather_comm, status)
      _VERIFY(status)
      
      call MPI_Comm_rank(gather_comm, rank, status)
      _VERIFY(status)
      call MPI_Comm_split(MPI_COMM_WORLD, rank, 0, writer_comm, status)
      _VERIFY(status)
      if (rank /= 0) writer_comm = MPI_COMM_NULL
      _RETURN_IF(writer_comm == MPI_COMM_NULL)

      benchmark = make_BW_Benchmark(spec, writer_comm, _RC)

      call write_header(writer_comm, _RC)

      tot_time = 0
      tot_time_sq = 0
      associate (n => spec%n_tries)
        do i = 1, n
           t = time(benchmark, writer_comm, _RC)
           tot_time = tot_time + t
           tot_time_sq = tot_time_sq + t**2
        end do
        avg_time = tot_time / n

        std_time = -1 ! unless
        if (n > 1) then
           std_time = sqrt((tot_time_sq - spec%n_tries*avg_time**2)/(n-1))
        end if
      end associate

      call report(spec, avg_time, std_time, writer_comm, _RC)

      _RETURN(_SUCCESS)
   end subroutine run


   real function time(benchmark, comm, rc)
      type(BW_Benchmark), intent(in) :: benchmark
      integer, intent(in) :: comm
      integer, optional, intent(out) :: rc

      integer :: status
      integer :: rank
      integer(kind=INT64) :: c0, c1, count_rate

      call MPI_Barrier(comm, status)
      _VERIFY(status)

      call system_clock(c0)
      call benchmark%run(_RC)
      call MPI_Barrier(comm, status)
      _VERIFY(status)
      call system_clock(c1, count_rate=count_rate)

      time = real(c1-c0)/count_rate

      _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, status)
      _VERIFY(status)
      _RETURN_UNLESS(rank == 0)

      write(*,'(3(a10,","),6(a15,:,","))',iostat=status) &
           'NX', '# levs', '# writers', 'write (GB)', 'packet (GB)', &
           'Time (s)', 'Eff. BW (GB/s)', 'Avg. BW (GB/s)', 'Rel. Std. Dev.'

      _RETURN(status)
   end subroutine write_header


   subroutine report(spec, avg_time, std_time, comm, rc)
      type(BW_BenchmarkSpec), intent(in) :: spec
      real, intent(in) :: avg_time
      real, intent(in) :: std_time
      integer, intent(in) :: comm
      integer, optional, intent(out) :: rc

      integer :: status
      real :: packet_gb
      real :: total_gb
      real :: bw
      integer :: npes
      integer :: rank
      integer, parameter :: WORD_SIZE = 4
      integer(kind=INT64) :: packet_size

      call MPI_Comm_size(comm, npes, status)
      _VERIFY(status)
      call MPI_Comm_rank(comm, rank, status)
      _VERIFY(status)
      _RETURN_UNLESS(rank == 0)

      packet_size = int(spec%nx,kind=INT64)**2 * 6 * spec%n_levs / spec%n_writers
      packet_gb = 1.e-9*(WORD_SIZE * packet_size)
      total_gb = packet_gb * npes
      bw = total_gb / avg_time

      call MPI_Comm_size(comm, npes, status)
      _VERIFY(status)

      write(*,'(3(1x,i9.0,","),6(f15.4,:,","))') &
           spec%nx, spec%n_levs, spec%n_writers, &
           total_gb, packet_gb, avg_time, bw, bw/npes, std_time/avg_time

      _RETURN(_SUCCESS)
   end subroutine report


end program main