io_profiling_m.f90

!
!  Copyright (C) 2013, Northwestern University
!  See COPYRIGHT notice in top-level directory.
!

      module io_profiling_m
      ! module for Read-Write Restart files
      use mpi
      implicit none

      character*256 :: dir_path      ! directory name for output files
      integer file_info, info_used

      integer          read_num      ! number of read calls
      integer          write_num     ! number of write calls
      double precision read_amount   ! total read amount
      double precision write_amount  ! total write amount
      double precision io_amount     ! total I/O amount
      double precision openT, writeT, readT, closeT
                       ! time for open, write, read, and close

      contains

      ! ----------------------------------------------------------------
      ! print the MPI info objects to stdout
      ! ----------------------------------------------------------------
      subroutine print_io_hints(info)
          implicit none
          integer, intent(in) :: info

          ! local variables
          character*(MPI_MAX_INFO_VAL) key, value
          integer                      i, nkeys, valuelen, err
          logical                      flag

 1001     FORMAT('    ',A32,' = ',A)
          call MPI_Info_get_nkeys(info, nkeys, err)
          print *, '---- MPI file info used ----'
          do i=0, nkeys-1
              key(:) = ' '
              call MPI_Info_get_nthkey(info, i, key, err)
              call MPI_Info_get(info, key, MPI_MAX_INFO_VAL, value, flag, err)
              call MPI_Info_get_valuelen(info, key, valuelen, flag, err)
              value(valuelen+1:) = ' '
              if (key(len_trim(key):len_trim(key)) .EQ. char(0)) &
                  key(len_trim(key):) = ' '
              print 1001, trim(key), trim(value)
          enddo
          print *
      end subroutine print_io_hints

      ! ----------------------------------------------------------------
      ! get the file striping information from the MPI info objects
      ! ----------------------------------------------------------------
      subroutine get_file_striping(info, striping_factor, striping_unit)
          implicit none
          integer, intent(in)  :: info
          integer, intent(out) :: striping_factor
          integer, intent(out) :: striping_unit

          ! local variables
          character*(MPI_MAX_INFO_VAL) key, value
          integer                      i, nkeys, valuelen, err
          logical                      flag

          call MPI_Info_get_nkeys(info, nkeys, err)
          do i=0, nkeys-1
              key(:) = ' '
              call MPI_Info_get_nthkey(info, i, key, err)
              call MPI_Info_get(info, key, MPI_MAX_INFO_VAL, value, flag, err)
              call MPI_Info_get_valuelen(info, key, valuelen, flag, err)
              value(valuelen+1:) = ' '
              if (key(len_trim(key):len_trim(key)) .EQ. char(0)) &
                  key(len_trim(key):) = ' '
              if (trim(key) .EQ. 'striping_factor') &
                  read(value, '(i10)') striping_factor
              if (trim(key) .EQ. 'striping_unit') &
                  read(value, '(i10)') striping_unit
          enddo
      end subroutine get_file_striping

      !----< set_io_hints() >-------------------------------------------
      subroutine set_io_hints(flag)
          implicit none
          integer, intent(in) :: flag

          ! local variables
          integer err

          ! free up info and file type
          if (flag .EQ. -1) then
              if (file_info .NE. MPI_INFO_NULL) then
                  call MPI_Info_free(file_info, err)
                  file_info = MPI_INFO_NULL
              endif
              return
          endif

          read_amount  = 0.0
          write_amount = 0.0
          io_amount    = 0.0
          read_num     = 0
          write_num    = 0
          openT        = 0.0
          writeT       = 0.0
          readT        = 0.0
          closeT       = 0.0
          info_used    = MPI_INFO_NULL

          ! set MPI I/O hints for performance enhancement
          call MPI_Info_create(file_info, err)

          ! set PnetCDF hints
          call MPI_Info_set(file_info, "nc_var_align_size", "1", err);
          call MPI_Info_set(file_info, "nc_in_place_swap", "enable", err);

      end subroutine set_io_hints

      !----< print_io_performance() >-----------------------------------
      subroutine  print_io_performance(io_time)
          use topology_m, only : gcomm, myid, npes
          use param_m,    only : nx_g, ny_g, nz_g
          use runtime_m,  only : method, restart
          implicit none
          double precision, intent(inout) :: io_time

          ! local variables
          double precision d_tmp, read_bandwidth, write_bandwidth, io_bandwidth
          integer          striping_factor, striping_unit, err

          call MPI_Reduce(openT,        d_tmp, 1, MPI_DOUBLE_PRECISION, MPI_MAX, 0, gcomm, err)
          openT     = d_tmp
          call MPI_Reduce(writeT,       d_tmp, 1, MPI_DOUBLE_PRECISION, MPI_MAX, 0, gcomm, err)
          writeT    = d_tmp
          call MPI_Reduce(readT,        d_tmp, 1, MPI_DOUBLE_PRECISION, MPI_MAX, 0, gcomm, err)
          readT     = d_tmp
          call MPI_Reduce(closeT,       d_tmp, 1, MPI_DOUBLE_PRECISION, MPI_MAX, 0, gcomm, err)
          closeT    = d_tmp
          call MPI_Reduce(io_time,      d_tmp, 1, MPI_DOUBLE_PRECISION, MPI_MAX, 0, gcomm, err)
          io_time   = d_tmp
          call MPI_Reduce(read_amount,  d_tmp, 1, MPI_DOUBLE_PRECISION, MPI_SUM, 0, gcomm, err)
          read_amount = d_tmp
          call MPI_Reduce(write_amount, d_tmp, 1, MPI_DOUBLE_PRECISION, MPI_SUM, 0, gcomm, err)
          write_amount = d_tmp
          io_amount = read_amount + write_amount

          if (myid == 0) then
              io_bandwidth    = 0.0
              read_bandwidth  = 0.0
              write_bandwidth = 0.0
              if (io_time > 0) io_bandwidth    = io_amount    / io_time
              if (readT   > 0) read_bandwidth  = read_amount  / readT
              if (writeT  > 0) write_bandwidth = write_amount / writeT
              io_bandwidth    = io_bandwidth    / 1048576.0
              io_amount       = io_amount       / 1073741824.0
              read_bandwidth  = read_bandwidth  / 1048576.0
              read_amount     = read_amount     / 1073741824.0
              write_bandwidth = write_bandwidth / 1048576.0
              write_amount    = write_amount    / 1073741824.0

              striping_factor = 0
              striping_unit   = 0
              if (info_used .NE. MPI_INFO_NULL) then
                  call print_io_hints(info_used)
                  call get_file_striping(info_used, striping_factor, striping_unit)
              endif

 2000         FORMAT(A)
 2001         FORMAT(A, A)
 2002         FORMAT(A ,I7)
 2003         FORMAT(A ,I7, A)
 2004         FORMAT(A ,F10.2, A)
 2005         FORMAT(A, i7,' x',i7,' x',i7)

              write(6,*) '++++ I/O is done through PnetCDF ++++'
              if (method .EQ. 0) then
                  write(6,*) 'I/O method          : blocking APIs'
              else
                  write(6,*) 'I/O method          : nonblocking APIs'
              endif
              if (restart) then
                  write(6,*) 'Run with restart    : True'
              else
                  write(6,*) 'Run with restart    : False'
              endif
              write(6, 2002) ' No. MPI processes   : ', npes
              write(6, 2005) ' Global array size   : ', nx_g, ny_g, nz_g
              write(6, 2001) ' output file path    : ',trim(dir_path)
              write(6, 2002) ' file striping count : ',striping_factor
              write(6, 2003) ' file striping size  : ',striping_unit, ' bytes'
              write(6, 2000) ' -----------------------------------------------'
              write(6, 2004) ' Time for open       :  ',openT,      ' sec'
              write(6, 2004) ' Time for read       :  ',readT,      ' sec'
              write(6, 2004) ' Time for write      :  ',writeT,     ' sec'
              write(6, 2004) ' Time for close      :  ',closeT,     ' sec'
              write(6, 2003) ' no. read  calls     :  ',read_num, '    per process'
              write(6, 2003) ' no. write calls     :  ',write_num,'    per process'
              write(6, 2004) ' total read  amount  :  ',read_amount ,  ' GiB'
              write(6, 2004) ' total write amount  :  ',write_amount , ' GiB'
              write(6, 2004) ' read  bandwidth     :  ',read_bandwidth ,  ' MiB/s'
              write(6, 2004) ' write bandwidth     :  ',write_bandwidth , ' MiB/s'
              write(6, 2000) ' -----------------------------------------------'
              write(6, 2004) ' total I/O   amount  :  ',io_amount , ' GiB'
              write(6, 2004) ' total I/O   time    :  ',io_time , ' sec'
              write(6, 2004) ' I/O   bandwidth     :  ',io_bandwidth, ' MiB/s'
          endif

          if (info_used .NE. MPI_INFO_NULL) &
              call MPI_Info_free(info_used, err)

      end subroutine  print_io_performance

      end module io_profiling_m