driver.F90 Source File

#define I_AM_MAIN
#include "MAPL_ErrLog.h"
program main
   use mapl_GathervSpec
   use mapl_GathervKernel
   use mapl_ErrorHandlingMod
   use mpi
   implicit none

   type(GathervSpec) :: spec
   integer :: status
      
   call mpi_init(status)
   _VERIFY(status)
   spec = make_GathervSpec() ! 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(GathervSpec), intent(in) :: spec
      integer, optional, intent(out) :: rc

      integer :: status

      real :: tot_time
      real :: tot_time_sq
      real :: avg_time
      real :: rel_std_time
      type(GathervKernel) :: kernel
      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)

      kernel = make_GathervKernel(spec, gather_comm, _RC)

      call write_header(MPI_COMM_WORLD, _RC)

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

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

      call report(spec, avg_time, rel_std_time, MPI_COMM_WORLD, _RC)

      _RETURN(_SUCCESS)
   end subroutine run


   real function time(kernel, comm, rc)
      type(GathervKernel), intent(in) :: kernel
      integer, intent(in) :: comm
      integer, optional, intent(out) :: rc

      integer :: status
      real :: t0, t1

      call MPI_Barrier(comm, status)
      _VERIFY(status)
      t0 = MPI_Wtime()
      call kernel%run(_RC)
      call MPI_Barrier(comm, status)
      _VERIFY(status)
      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, status)
      _VERIFY(status)
      _RETURN_UNLESS(rank == 0)
      
      write(*,'(4(a6,","),3(a15,:,","))',iostat=status) 'NX', '# levs', '# writers', 'group size', 'Time (s)', 'Rel. Std. dev.', 'BW (GB/sec)'

      _RETURN(status)
   end subroutine write_header


   subroutine report(spec, avg_time, rel_std_time, comm, rc)
      type(GathervSpec), intent(in) :: spec
      real, intent(in) :: avg_time
      real, intent(in) :: rel_std_time
      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, status)
      _VERIFY(status)
      _RETURN_UNLESS(rank == 0)

      call MPI_Comm_size(MPI_COMM_WORLD, npes, status)
      _VERIFY(status)
      group = npes /spec%n_writers

      bw_gb = 1.e-9 * WORD * (spec%nx**2)*6*spec%n_levs / avg_time
      write(*,'(4(i6.0,","),3(f15.4,:,","))') spec%nx, spec%n_levs, spec%n_writers, group, avg_time, rel_std_time, bw_gb
 
      _RETURN(_SUCCESS)
   end subroutine report


end program main