PRACE NPT

      Program mod1k

! ----------------------------------------------------------------------

      Use                      numerics

      Use                      dist_module

      Implicit                 None

      Include                 'mpif.h'

      Integer               :: comm, ierr, status,

     &                         istat(MPI_Status_Size), my_win 

      Integer               :: i, ireps, length, nreps

      Integer(8), Parameter :: disp = 0

      Integer(8), Parameter :: mlen = 8000000 ! <=== Max window size.

      Logical               :: ok

      Integer               :: message(mlen)

      Real(l_)              :: incpt, perc, slope, time

      Real(l_)              :: bw, bwmax, latency, lperc

      Common /buffer/          message

! ----------------------------------------------------------------------

! --- Initialise MPI, make window, initialise message array.

!     Also initialise the least-squares routine and max. bandwidth.

! ----------------------------------------------------------------------

      Call csetup

      comm = MPI_Comm_World

      Call MPI_Win_Create( message, mlen, 4, MPI_Info_Null,

     &                     comm, my_win, ierr )

      If ( me == 0 ) Then

         Call lsq( 0, 0.0_l_, 0.0_l_, slope, incpt, perc )

         bwmax = 0.0_l_

      End If

      message = 0

      If ( me == 0 ) Then

         Do i = 1, mlen

            message(i) = i

         End Do

      End If

! ----------------------------------------------------------------------

! --- Call identification routine.

! ----------------------------------------------------------------------

      If ( me == 0 ) Then

          Call state('mod1k   ')

          Print 1000

      End If

      Open( 1, File = 'mod1k.in' )

! ---------------------------------------------------------------------

! --- Get new case from the input file for the MPI_Get test.

! ---------------------------------------------------------------------

   10 Read( 1, *, End = 20 ) length, nreps

! ----------------------------------------------------------------------

! --- Measure MPI_Get:

! ----------------------------------------------------------------------

      If ( me == 1 ) Then

         time = MPI_Wtime()

         Do ireps = 1, nreps

            Call MPI_Get( message, length, MPI_Integer, 0, disp, length,

     &                    MPI_Integer, my_win, ierr )

         End Do

         time = ( MPI_Wtime() - time )/( Real( nreps, l_ ) )

         Call lsq( 1, Real( length, l_ ), time, slope, incpt, perc )

         If ( length == 50 ) Then

            latency = incpt*1.0e6_l_

            lperc   = perc

         End If

         bw = 1.0e-6_l_*Real( 4*length, l_ )/time

         bwmax = Max( bwmax, bw )

         ok   = .TRUE.

         Call check( message, length, ok )

         Print 1010, 4*length, time, bw, ok

      End If

      Call MPI_Win_Fence( 0, my_win, ierr )

      Go To 10                     ! <=================================

   20 If ( me == 1 ) Then

         Print 1020

         Print 1040, bwmax, latency, lperc

      End If

      Call MPI_Barrier( comm, ierr )

! ----------------------------------------------------------------------

! --- Measure MPI_Put:

! ----------------------------------------------------------------------

      Rewind 1

      If ( me == 1 ) message = 0

      If ( me == 0 ) Then

         Print 1030

         Call lsq( 0, 0.0_l_, 0.0_l_, slope, incpt, perc )

         bwmax = 0.0_l_

      End If

   30 Read( 1, *, End = 40 ) length, nreps

      If ( me == 0 ) Then

         time = MPI_Wtime()

         Do ireps = 1, nreps

            Call MPI_Put( message, length, MPI_Integer, 1, disp, length,

     &                    MPI_Integer, my_win, ierr )

         End Do

         time = ( MPI_Wtime() - time )/( Real( nreps, l_ ) )

      End If

      ok = .TRUE.

      If ( me == 1 ) Call check( message, length, ok )

      If ( me == 0 ) Then

         Call MPI_Get( ok, 1, MPI_Logical, 1, disp, 1, MPI_Logical,

     &                 my_win, ierr )

         Call lsq( 1, Real( length, l_ ), time, slope, incpt, perc )

         If ( length == 50 ) Then

            latency = incpt*1.0e6_l_

            lperc   = perc

         End If

         bw = 1.0e-6_l_*Real( 4*length, l_ )/time

         bwmax = Max( bwmax, bw )

         Print 1010, 4*length, time, bw, ok

      End If

      Call MPI_Win_Fence( 0, my_win, ierr )

      Go To 30                     ! <=================================

   40 If ( me == 0 ) Then

         Print 1020

         Print 1040, bwmax, latency, lperc

      End If

      Call MPI_Finalize( ierr )

! ---------------------------------------------------------------------

 1000 Format('Program mod1k: One-sided distr. memory communication'/

     &       '----------------------------------------------------'/

     &       '| Mess. length |  MPI_Get time |   Bandwidth   |   |'/

     &       '|    (Bytes)   |   (seconds)   |   (Mbyte/s)   |OK?|'/

     &       '----------------------------------------------------' )

 1010 Format('|', 3x, i8, 3x, '|', 1x, g13.5, 1x, '|', 1x, g13.5, 1x,

     &       '|', l2,' |' )

 1020 Format('----------------------------------------------------' )

 1030 Format(//

     &       '----------------------------------------------------'/

     &       '| Mess. length |  MPI_Put time |   Bandwidth   |   |'/

     &       '|    (Bytes)   |   (seconds)   |   (Mbyte/s)   |OK?|'/

     &       '----------------------------------------------------' )

 1040 Format( 'Maximum bandwidth = ' g12.5, ' MB/s'/

     &        'Latency   = ', g11.4, ' microsec., Error = ', f6.2, '%'/

     &        '-------------------------------------------------------')

! ---------------------------------------------------------------------

      End Program mod1k