ss.for

在fortran编译环境下用mpi实现两个二维矩阵相乘

      program matrix
	implicit none
	include 'mpif.h'
	integer arows,acols,brows,bcols
	real,dimension(:,:),allocatable::a,b,c
      real,dimension(:),allocatable::buffer1,buffer2
	real ans
	integer rank,size,master,ierr,status(MPI_STATUS_SIZE)
	integer i,j,k,r,numsent,sender
	integer anstype,row
	
	call MPI_INIT(ierr)
	call MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierr)
	call MPI_COMM_SIZE(MPI_COMM_WORLD,size,ierr)
	master=0

	if(rank==master)then

      open(unit=0,file='rows_cols.txt')
	read(0,*) arows,acols,brows,bcols

	if(acols==brows)then
      print*,'矩阵A:',arows,' 行',acols,' 列'
	print*,'矩阵B:',brows,' 行',bcols,' 列'
	else
	print*,'矩阵A行数不等于矩阵B列数，不符合矩阵相乘要求，
     $	请修改相关值重新运行!'
	 stop
	 endif

	close(0)

	end if

      call MPI_BCAST(acols,1,MPI_INTEGER,master,MPI_COMM_WORLD,ierr)
	call MPI_BCAST(brows,1,MPI_INTEGER,master,MPI_COMM_WORLD,ierr)

	if(rank==master)then

	allocate(a(1:arows,1:acols),b(1:brows,1:bcols),c(1:arows,1:bcols))
	allocate(buffer1(1:acols),buffer2(1:brows))
	open(1,file='a_date.txt')
	do i=1,arows
	 do j=1,acols
	read(1,*) a(i,j)
	end do
	end do
	close(1)

	open(2,file='b_date.txt')
      do i=1,brows
	 do j=1,bcols
	read(2,*) b(i,j)
	end do
	end do
	print *,"矩阵A:" 
	do i=1,arows
      print *,(a(i,j),j=1,acols) 
	end do
	print *,"矩阵B:" 
	do i=1,brows
      print *,(b(i,j),j=1,bcols) 
	end do

	print*,'A×B:'
      
      do i=1,arows

	numsent=0

	 do j=1,acols
	  buffer1(j)=a(i,j)
	end do


      do k=1,min(size-1,bcols)
	 do j=1,brows
	  buffer2(j)=b(j,k)
	 end do
	
	call MPI_SEND(buffer2,brows,MPI_REAL,k,k,MPI_COMM_WORLD,ierr)
	numsent=numsent+1
      end do

	call MPI_BCAST(buffer1,acols,MPI_REAL,master,MPI_COMM_WORlD,ierr)

      do r=1,bcols
	call MPI_RECV(ans,1,MPI_REAL,MPI_ANY_SOURCE,
     $ MPI_ANY_TAG,MPI_COMM_WORLD,status,ierr)
	sender=status(MPI_SOURCE)
	anstype=status(MPI_TAG)
      c(i,anstype)=ans
	print*,i,anstype,c(i,anstype)
	
	if(numsent.lt.bcols) then

      call MPI_BCAST(buffer1,acols,MPI_REAL,master,MPI_COMM_WORlD,ierr)

	do j=1,brows
	 buffer2(j)=b(j,numsent+1)
	end do
      	
	call MPI_SEND(buffer2,brows,MPI_REAL,sender,numsent+1,
     $	MPI_COMM_WORLD,ierr)
	numsent=numsent+1


	 end if
	end do
	end do

		
      deallocate(a,b,buffer1,buffer2)
	
	else



1     allocate(buffer1(1:acols))
	allocate(buffer2(1:brows))
      call MPI_RECV(buffer2,brows,MPI_REAL,master,MPI_ANY_TAG,
     $MPI_COMM_WORLD,status,ierr)
	call MPI_BCAST(buffer1,acols,MPI_REAL,master,MPI_COMM_WORLD,ierr)
	

	row=status(MPI_TAG)
	ans=0.0
	do i=1,acols
	 ans=ans+buffer1(i)*buffer2(i)
	end do
	call MPI_SEND(ans,1,MPI_REAL,master,row,MPI_COMM_WORLD,ierr)
	deallocate(buffer1,buffer2)

      goto 1

	end if

	if(rank==master) then
	print*,'结果矩阵C:'

 	open(unit=2,file='结果.txt')     
	do i=1,arows
	print*,(c(i,j),j=1,bcols)
	write(2,*),'相乘结果:',(c(i,j),j=1,bcols)
	end do

	endif
      
	call MPI_FINALIZE(ierr)
	end program matrix