matdotvector2.f90
Printed: 129/19/10 3:35:15 PM
Page 1 of 2
Printed For: Miguel Oliveira
program matdotvector3
include 'mpif.h'
integer rows, cols, row, dest, status(MPI_STATUS_SIZE)
integer ierr, myid, nproc
double precision, dimension(:), allocatable :: a, aa, c, buffer
double precision, dimension(:,:), allocatable :: b
call MPI_Init(ierr)
call MPI_COMM_RANK(MPI_COMM_WORLD,myid,ierr)
call MPI_COMM_SIZE(MPI_COMM_WORLD,nproc,ierr)
rows=10
cols=10
allocate(a(rows))
allocate(aa(rows))
allocate(b(rows,cols))
allocate(c(cols),buffer(cols))
do i = 1, rows
a(i) = 0.0
enddo
if ( myid == 0) then
do j=1,cols
c(j)=1.0
do i=1,rows
b(i,j)=i
enddo
enddo
call MPI_Bcast(c,cols,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ierr)
dest=1
do i=1,rows
if ( dest == nproc ) then
dest=1
endif
do j=1,cols
buffer(j)=b(i,j)
enddo
call MPI_Send(buffer,cols,MPI_DOUBLE_PRECISION,dest,i,MPI_COMM_WORLD,ierr)
dest=dest+1
enddo
do i=1,nproc-1
call MPI_Send(buffer,cols,MPI_DOUBLE_PRECISION,i,0,MPI_COMM_WORLD,ierr)
enddo
else
call MPI_Bcast(c,cols,MPI_DOUBLE_PRECISION,0,MPI_COMM_WORLD,ierr)
row = 1
do while ( row .ne. 0 )
call MPI_Recv(buffer,cols,MPI_DOUBLE_PRECISION,0,MPI_ANY_TAG,MPI_COMM_WORLD,status
row = status(MPI_TAG)
if ( row .ne. 0 ) then
ans = 0.0
do i = 1, cols
ans = ans + buffer(i) * c(i)
enddo
a(row) = ans
endif
matdotvector2.f90
Printed: 129/19/10 3:35:15 PM
Page 2 of 2
Printed For: Miguel Oliveira
enddo
endif
call MPI_Reduce(a,aa,rows,MPI_DOUBLE_PRECISION,MPI_SUM,0,MPI_COMM_WORLD,ierr)
if ( myid == 0 ) then
do i = 1, rows
print *,"a(",i,")=",aa(i)
enddo
endif
deallocate(a)
deallocate(aa)
deallocate(b)
deallocate(c)
call MPI_FINALIZE(ierr)
stop
end