program prod
include 'mpif.h'
integer max
parameter (max=1000)
integer noprocs, nid, i, n, size, error
integer status(MPI_STATUS_SIZE)
real a(0:max-1), b(0:max-1), sum, Gsum
call MPI_Init(error)
call MPI_Comm_rank(MPI_COMM_WORLD, nid,
error)
call MPI_Comm_size(MPI_COMM_WORLD, noprocs,
error)
if (nid .eq. 0) then
open(9,file='DotData.Txt',form='formatted')
read(9,*)n
call MPI_Bcast(n,1,MPI_INTEGER,0,MPI_COMM_WORLD,error)
if (n .gt. max) then
write(6,*) ('Need to increase dimension of arrays a and b!')
call MPI_Abort(MPI_COMM_WORLD,-1,error)
end if
if (mod(n,noprocs)
.ne. 0) then
write(6,*) ('Number of processes is not a multiple of n.')
call MPI_Abort(MPI_COMM_WORLD,-1,error)
end if
do 10 i=0,n-1
read(9,*)a(i),b(i)
10 continue
close(9)
size = n / noprocs
do 20 i=1,noprocs-1
call MPI_Send(a(size*i),size,MPI_REAL,i,10,MPI_COMM_WORLD,
&
error)
call MPI_Send(b(size*i),size,MPI_REAL,i,20,MPI_COMM_WORLD,
&
error)
20 continue
else
call MPI_Bcast(n,1,MPI_INTEGER,0,MPI_COMM_WORLD,error)
if (n .gt. max .or.
mod(n,noprocs) .ne. 0) then
call MPI_Abort(MPI_COMM_WORLD,-1,error)
end if
size = n / noprocs
call MPI_Recv(a(0),size,MPI_REAL,0,10,MPI_COMM_WORLD,status,
& error)
call MPI_Recv(b(0),size,MPI_REAL,0,20,MPI_COMM_WORLD,status,
& error)
end if
sum = 0.0
do 30 i=0,size-1
sum = sum + a(i) *
b(i)
30 continue
call MPI_Reduce(sum,Gsum,1,MPI_REAL,MPI_SUM,0,MPI_COMM_WORLD,
& error)
if (nid .eq. 0) then
write(6,*)'The inner
product is ',Gsum
end if
call MPI_Finalize(error)
stop
end