! day1ex3_ex.f90
include "mpiSim.f90"
program main
include "useSim.f90"

!*****************************************************************************80
!
!! MAIN is the main program for DAY1_EX3.
!
!  Discussion:
!
!    DAY1_EX3 is exercise 3 for first day of the MPI workshop.
!
!    The instructions say:
!
!    Process 1 computes the squares of the first 200 integers.
!    It sends this data to process 3.
!
!    Process 3 should divide the integers between 20 and 119 by 53,
!    getting a real result, and passes this data back to process 1.
!
!    * I presume the first 200 integers are the numbers 0 through 199.
!
!    * The instructions literally mean that process 3 should look
!      at integers whose VALUES are between 20 and 119.  I doubt that
!      is what the instructor meant, but it's more interesting than
!      simply picking the entries with index between 20 and 119,
!      so that's what I'll do.
!
!    * It is also not completely clear whether only the selected data
!      should be sent back, or the entire array.  Again, it is more
!      interesting to send back only part of the data.
!
!  Modified:
!
!    18 October 2005
!
!  Author:
!
!    John Burkardt
!
!  Reference:
!
!    William Gropp, Ewing Lusk, Anthony Skjellum,
!    Using MPI: Portable Parallel Programming with the
!    Message-Passing Interface,
!    Second Edition,
!    MIT Press, 1999,
!    ISBN: 0262571323.
!

!
!  Fortran77 include file:
!
! include 'mpif.h'
!
!  Fortran90 module:
!
!  implicit none
!
!  use mpi
!
  integer, parameter :: i_dim = 200
  integer, parameter :: r_dim = 200

  integer count
  integer count2
  integer dest
  integer i
  integer i_buffer(i_dim)
  integer ierr
  integer num_procs
  real r_buffer(r_dim)
  integer rank
  integer source
  integer status(MPI_Status_size)
  integer tag
!
!  Initialize MPI.
!
  call MPI_Init ( ierr )
!
!  Determine this process's rank.
!
  call MPI_Comm_rank ( MPI_COMM_WORLD, rank, ierr )
!
!  Have Process 0 say hello.
!
  if ( rank == 0 ) then

    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'DAY1_EX3:'
    write ( *, '(a)' ) '  FORTRAN90 version'
    write ( *, '(a)' ) '  MPI exercise #3 for day 1.'
! $$Error: num_procs is undefined so should not be printed here.
    write ( *, '(a,i8)' ) '  The number of processes available is ', num_procs

  end if
!
!  Get the number of processes.
!
  call MPI_Comm_size ( MPI_COMM_WORLD, num_procs, ierr )
!
!  If we don't have at least 4 processes, then bail out now.
!
  if ( num_procs < 4 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a,i8)' ) 'DAY1_EX3 - Process ', rank
    write ( *, '(a)' ) '  Not enough processes for this task!'
    write ( *, '(a)' ) '  Bailing out now!'
    call MPI_Finalize ( ierr )
    stop
  end if
!
!  Process 1 knows that it will generate 200 integers, and may receive no more
!  than 200 reals.
!
  if ( rank == 1 ) then

    count = 200

    do i = 1, count
      i_buffer(i) = ( i - 1 )**2
    end do

    dest = 3
    tag = 1

    call MPI_Send ( i_buffer, count, MPI_INTEGER, dest, tag, &
      MPI_COMM_WORLD, ierr )

    write ( *, '(a,i1,a,i3,a,i1)' ) 'P:', rank, ' sent ', count, &
      ' integers to process ', dest

    source = 3
    tag = 2

    call MPI_Recv ( r_buffer, r_dim, MPI_REAL, source, tag, &
      MPI_COMM_WORLD, status, ierr )

    write ( *, '(a,i1,a,i1)' ) 'P:', rank, &
      ' received real values from process 3.'

    call MPI_Get_count ( status, MPI_INTEGER, count, ierr )

    write ( *, '(a,i1,a,i3,a)' ) 'P:', rank, &
      ' Number of real values received is ', count

    write ( *, '(a,i1,a,3f8.4)' ) 'P:', rank, &
      ' First 3 values = ', r_buffer(1:3)
!
!  Process 3 receives the integer data from process 1, selects some
!  of the data, does a real computation on it, and sends that part
!  back to process 1.
!
  else if ( rank == 3 ) then

    source = 1
    tag = 1

    call MPI_Recv ( i_buffer, i_dim, MPI_INTEGER, source, tag, &
      MPI_COMM_WORLD, status, ierr )

    write ( *, '(a)' ) ' '
    write ( *, '(a,i1,a)' ) 'P:', rank, &
      ' received integer values from process 1.'

    call MPI_Get_count ( status, MPI_INTEGER, count, ierr )

    write ( *, '(a,i1,a,i8)' ) 'P:', rank, &
      ' - Number of integers received is ', count
    write ( *, '(a,i1,a,3i8)' ) 'P:', rank, ' First 3 values = ', i_buffer(1:3)

    count2 = 0

    do i = 1, count

      if ( 20 <= i_buffer(i) .and. i_buffer(i) <= 119 ) then

        count2 = count2 + 1
        r_buffer(count2) = real ( i_buffer(i) ) / 53.0E+00

        if ( count2 <= 3 ) then
          write ( *, '(a,i1,a,i8,a,f8.4)' ) 'P:', rank, ' Input integer ', &
            i_buffer(i), ' becomes ', r_buffer(count2)
        end if

      end if

    end do

    dest = 1
    tag = 2

    call MPI_Send ( r_buffer, count2, MPI_REAL, dest, tag, &
      MPI_COMM_WORLD, ierr )

    write ( *, '(a,i1,a,i3,a,i1)' ) 'P:', rank, ' sent ', count2, &
      ' reals to process ', dest

  else

    write ( *, '(a)' ) ' '
    write ( *, '(a,i1,a)' ) 'P:', rank, ' - MPI has no work for me!'

  end if

  call MPI_Finalize ( ierr )

  if ( rank == 0 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'DAY1_EX3:'
    write ( *, '(a)' ) '  Normal end of execution.'
  end if

  stop
end