C ------------------------------------------------------------------------
C pi_send.f
C FILES: pi_send.f, dboard.f, make.pi.f
C DESCRIPTION: MPI pi calculation example program. Fortran version.
C This program calculates pi using a "dartboard" algorithm. See
C Fox et al.(1988) Solving Problems on Concurrent Processors, vol.1
C page 207. All processes contribute to the calculation, with the
C master averaging the values for pi.
C
C SPMD Version: Conditional statements check if the process is the
C master or a worker.
C
C This version uses low level sends and receives to collect results
C
C AUTHOR: Roslyn Leibensperger (C program for PVM).
C REVISED: 05/11/93 Blaise Barney Ported to Fortran.
C 05/24/93 R. Leibensperger Ported to API.
C 01/10/94 S. Pendell Changed API to MPL.
C 05/18/94 R. Leibensperger Non-blocking send.
C CONVERTED TO MPI: 11/12/94 by Xianneng Shen.
C ------------------------------------------------------------------------
C Explanation of constants and variables used in this program:
C DARTS = number of throws at dartboard
C ROUNDS = number of times "DARTS" is iterated
C MASTER = task ID of master task
C mytid = task ID of current task
C nproc = number of tasks
C homepi = value of pi calculated by current task
C pi = average of pi for this iteration
C avepi = average pi value for all iterations
C pirecv = pi received from worker
C pisum = sum of workers' pi values
C seednum = seed number - based on mytid
C source = source of incoming message
C mtype = message type
C sbytes = size of message being sent
C nbytes = size of message successfully sent
C rbytes = size of message received
C ------------------------------------------------------------------------
program pi_send
include 'mpif.h'
integer DARTS, ROUNDS, MASTER
parameter(DARTS = 5000)
parameter(ROUNDS = 10)
parameter(MASTER = 0)
integer ierr, status(MPI_STATUS_SIZE), request
integer mytid, nproc, source, mtype, msgid, sbytes, rbytes,
& i, n
real*4 seednum
real*8 homepi, pi, avepi, pirecv, pisum, dboard
C Obtain number of tasks and task ID
call mpi_init(ierr)
call mpi_comm_rank(MPI_COMM_WORLD, mytid, ierr)
call mpi_comm_size(MPI_COMM_WORLD, nproc, ierr)
write(*,*)'MPI task id = ', mytid
C Use the task id to set the seed number for the random number generator.
seednum = real(mytid)
call srand(seednum)
avepi = 0
do 40 i = 1, ROUNDS
C Calculate pi using dartboard algorithm
homepi = dboard(DARTS)
C ******************** start of worker section ***************************
C All workers send result to master. Steps include:
C -set message type equal to this round number
C -set message size to 8 bytes (size of real8)
C -send local value of pi (homepi) to master task
C -a non-blocking send followed by mpi_wait is used
C this is safe programming practice
if (mytid .ne. MASTER) then
mtype = i
sbytes = 8
call mpi_isend(homepi, 1, MPI_DOUBLE_PRECISION,
. MASTER, i, MPI_COMM_WORLD, request, ierr)
call mpi_wait(request, status, ierr)
C ******************** end of worker section *****************************
else
C ******************** start of master section **************************
C Master receives messages from all workers. Steps include:
C -set message type equal to this round
C -set message size to 8 bytes (size of real8)
C -receive any message of type mytpe
C -keep running total of pi in pisum
C Master then calculates the average value of pi for this iteration
C Master also calculates and prints the average value of pi over all
C iterations
mtype = i
sbytes = 8
pisum = 0
do 30 n = 1, nproc-1
call mpi_recv(pirecv, 1, MPI_DOUBLE_PRECISION,
. MPI_ANY_SOURCE, mtype, MPI_COMM_WORLD, status, ierr)
pisum = pisum + pirecv
30 continue
pi = (pisum + homepi)/nproc
avepi = ((avepi*(i-1)) + pi) / i
write(*,32) DARTS*i, avepi
32 format(' After',i6,' throws, average value of pi = ',f10.8)
C ********************* end of master section ****************************
endif
40 continue
call mpi_finalize(ierr)
end