program prod include 'mpif.h' integer max parameter (max=30000) 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