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

!***********************************************************************
!  http://www.csit.fsu.edu/~burkardt/f_src/mpi/mpi.html
!
!  BONES is a simple demonstration of the use of MPI by a FORTRAN90 program.
!        It passes a vector of real data from one process to another.
!  Discussion:
!
!    This program should be run on at least two processes.
!    Only the first two processes will get any work to do.
!
!  Modified:
!
!    16 October 2002
!
!  Reference:
!
!    Gropp, Lusk, Skjellum,
!    Using MPI,
!    Portable Parallel Programming with the Message-Passing Interface,
!    MIT Press, 1997.
!

!
!  Fortran77 include file:
!
! include 'mpif.h'
!
!  Fortran90 module:
!
!  implicit none
!
!  use mpi
!
  integer count
  real data(0:99)
  integer dest
  integer i
  integer ierr
  integer num_procs
  integer rank
  integer status(MPI_Status_size)
  integer tag
  real value(200)
!
!  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

    call MPI_Comm_size ( MPI_COMM_WORLD, num_procs, ierr )

    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'BONES:'
    write ( *, '(a)' ) '  A simple FORTRAN90 MPI test program.'
    write ( *, '(a,i6)' ) '  The number of processes available is ', num_procs

  end if
!
!  Process 0 expects to receive as much as 200 real values, from any source.
!
  if ( rank == 0 ) then

    tag = 55
    call MPI_Recv ( value, 200, MPI_REAL, MPI_ANY_SOURCE, tag, &
      MPI_COMM_WORLD, status, ierr )

    write ( *, '(a,i1,a,i1)' ) 'P:', rank, ' Got data from processor ', &
      status(MPI_SOURCE)

    call MPI_Get_count ( status, MPI_REAL, count, ierr )

    write ( *, '(a,i1,a,i3,a)' ) 'P:', rank, ' Got ', count, ' elements.'

    write ( *, '(a,i1,a,g14.6)' ) 'P:', rank, ' value(5) = ', value(5)
!
!  Process 1 sends 100 real values to process 0.
!
  else if ( rank == 1 ) then

    write ( *, '(a)' ) ' '
    write ( *, '(a,i1,a)' ) 'P:', rank, &
      ' - setting up data to send to process 0.'

    do i = 0, 99
      data(i) = real ( i )
    end do

    dest = 0
    tag = 55
    call MPI_Send ( data, 100, MPI_REAL, dest, tag, MPI_COMM_WORLD, ierr )

  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)' ) 'BONES:'
    write ( *, '(a)' ) '  Normal end of execution.'
  end if

  stop
end