!Tyler Simon & Tom Oppe !8/10/2006 !Time MPI startup program test double precision a(200000) include 'mpif.h' call mpi_init (ierror) do i = 1, 200000 a(i) = dble(i) enddo write (6, 100) a(100) call mpi_finalize (ierror) stop 100 format (1x, 'a(100) = ', f10.5) end subroutine mpi_init (ierror) include 'mpif.h' double precision tbeg common / TIMERcom / tbeg call pmpi_init (ierror) tbeg = mpi_wtime() return end subroutine mpi_finalize (ierror) include 'mpif.h' double precision tb, tbeg, tbeg_max, tbeg_min, tbeg_avg, tbeg_sum double precision te, tend, tend_max, tend_min, tend_avg, tend_sum double precision telp, telp_max, telp_min, telp_avg, telp_sum double precision ftimer1, ftimer2 character (len = mpi_max_processor_name) pname double precision, allocatable :: tbeg_all(:), tend_all(:) character (len = mpi_max_processor_name), allocatable :: pname_all(:) integer, allocatable :: len_name_all(:) integer comm common / TIMERcom / tbeg tend = mpi_wtime() comm = mpi_comm_world call mpi_comm_rank (comm, myid, ier) if (myid .eq. 0) then call system_clock (count = icount, count_rate = irate) ftimer1 = dble(icount)/dble(irate) endif call mpi_get_processor_name (pname, len_name, ier) mdbl = mpi_double_precision mchr = mpi_character mint = mpi_integer if (myid .eq. 0) then call mpi_comm_size (comm, nprocs, ier) npm1 = nprocs - 1 allocate (tbeg_all(0:npm1), tend_all(0:npm1)) allocate (pname_all(0:npm1)) allocate (len_name_all(0:npm1)) endif call mpi_gather (tbeg, 1, mdbl, tbeg_all, 1, mdbl, 0, comm, ier) call mpi_gather (tend, 1, mdbl, tend_all, 1, mdbl, 0, comm, ier) len = mpi_max_processor_name call mpi_gather (pname, len, mchr, pname_all, len, mchr, 0, comm, ier) call mpi_gather (len_name, 1, mint, len_name_all, 1, mint, 0, comm, ier) if (myid .eq. 0) then tbeg_sum = 0.0d0 tend_sum = 0.0d0 telp_sum = 0.0d0 tbeg_max = tbeg_all(0) tbeg_min = tbeg_all(0) tend_max = tend_all(0) tend_min = tend_all(0) telp_max = tend_all(0) - tbeg_all(0) telp_min = tend_all(0) - tbeg_all(0) i_tbeg_max = 0 i_tbeg_min = 0 i_tend_max = 0 i_tend_min = 0 i_telp_max = 0 i_telp_min = 0 do i = 0, npm1 tb = tbeg_all(i) te = tend_all(i) telp = te - tb tbeg_sum = tbeg_sum + tb tend_sum = tend_sum + te telp_sum = telp_sum + telp if (tb .gt. tbeg_max) then tbeg_max = tb i_tbeg_max = i endif if (tb .lt. tbeg_min) then tbeg_min = tb i_tbeg_min = i endif if (te .gt. tend_max) then tend_max = te i_tend_max = i endif if (te .lt. tend_min) then tend_min = te i_tend_min = i endif if (telp .gt. telp_max) then telp_max = telp i_telp_max = i endif if (telp .lt. telp_min) then telp_min = telp i_telp_min = i endif enddo tbeg_avg = tbeg_sum/dble(nprocs) tend_avg = tend_sum/dble(nprocs) telp_avg = telp_sum/dble(nprocs) write (6, 100) tbeg_max, i_tbeg_max, tbeg_min, i_tbeg_min, tbeg_avg, & tend_max, i_tend_max, tend_min, i_tend_min, tend_avg, & telp_max, i_telp_max, telp_min, i_telp_min, telp_avg, & tend_max - tbeg_min, tend_min - tbeg_max do i = 0, npm1 tb = tbeg_all(i) te = tend_all(i) telp = te - tb len = len_name_all(i) write (6, 105) i, telp, tb, te, (pname_all(i)(j:j), j = 1, len) enddo write (6, 110) mpi_wtime() - tend deallocate (tbeg_all, tend_all, pname_all, len_name_all) endif call pmpi_finalize (ierror) if (myid .eq. 0) then call system_clock (count = icount, count_rate = irate) ftimer2 = dble(icount)/dble(irate) write (6, 115) ftimer2 - ftimer1 endif return 100 format ( & 1x, '++++ TIMER ++++: *** Begin Timing Report ***'/ & 1x, '++++ TIMER ++++:'/1x, '++++ TIMER ++++:'/ & 1x, '++++ TIMER ++++: Max MPI_Init timer val = ', f22.6, ' at rank ', i6/ & 1x, '++++ TIMER ++++: Min MPI_Init timer val = ', f22.6, ' at rank ', i6/ & 1x, '++++ TIMER ++++: Avg MPI_Init timer val = ', f22.6/ & 1x, '++++ TIMER ++++:'/ & 1x, '++++ TIMER ++++: Max MPI_Fin timer val = ', f22.6, ' at rank ', i6/ & 1x, '++++ TIMER ++++: Min MPI_Fin timer val = ', f22.6, ' at rank ', i6/ & 1x, '++++ TIMER ++++: Avg MPI_Fin timer val = ', f22.6/ & 1x, '++++ TIMER ++++:'/ & 1x, '++++ TIMER ++++: Max Fin-Init timer val = ', f22.6, ' at rank ', i6/ & 1x, '++++ TIMER ++++: Min Fin-Init timer val = ', f22.6, ' at rank ', i6/ & 1x, '++++ TIMER ++++: Avg Fin-Init timer val = ', f22.6/ & 1x, '++++ TIMER ++++:'/ & 1x, '++++ TIMER ++++: Max Fin - Min Init val = ', f22.6/ & 1x, '++++ TIMER ++++: Min Fin - Max Init val = ', f22.6/ & 1x, '++++ TIMER ++++:'/ & 1x, '++++ TIMER ++++: Rank', 11x, 'Elapsed Time', 15x, 'MPI_Init', & 11x, 'MPI_Finalize', 7x, 'Processor Name') 105 format (1x, '++++ TIMER ++++: ', i8, 3f23.6, 7x, 40a1) 110 format (1x, '++++ TIMER ++++:'/ & 1x, '++++ TIMER ++++: Timer Overhead (inside MPI) from Rank 0 = ', f18.6) 115 format (1x, '++++ TIMER ++++: Timer and MPI_Finalize Overhead from Rank 0 = ', f18.6/ & 1x, '++++ TIMER ++++:'/1x, '++++ TIMER ++++:'/ & 1x, '++++ TIMER ++++: *** End Timing Report ***') end