请教关于fortran+mpi编cholesky分解的问题

haoyonghui

下面是我的程序，调试总有错。

program main
  include ';mpif.h';
  integer myid,numprocs,ierr,size
   
  double precision,dimension(0:5,0:5)::a,g
  integer n
   
  integer i,j,k,i1
  integer status(MPI_STATUS_SIZE)

   call MPI_INIT(ierr)
   call MPI_COMM_RANK(MPI_COMM_WORLD,myid,ierr)
   call MPI_COMM_SIZE(MPI_COMM_WORLD,numprocs,ierr)
  n=6
if(myid.EQ.0)then
   
  a(0,0)=2678
  a(0,1)=332
  a(0,2)=5790
  a(0,3)=843
  a(0,4)=1289
  a(0,5)=1753
  
  a(1,0)=1667
  a(1,1)=143
  a(1,2)=2965
  a(1,3)=467
  a(1,4)=735
  a(1,5)=11643
  
  a(2,0)=18254
  a(2,1)=479
  a(2,2)=535
  a(2,3)=679
  a(2,4)=943
  a(2,5)=13678
  
  a(3,0)=1954
  a(3,1)=735
  a(3,2)=833
  a(3,3)=9546
  a(3,4)=1045
  a(3,5)=1478
  
  a(4,0)=20256
  a(4,1)=1135
  a(4,2)=1275
  a(4,3)=1336
  a(4,4)=14267
  a(4,5)=15256

  a(5,0)=216778
  a(5,1)=1635
  a(5,2)=1778
  a(5,3)=8467
  a(5,4)=1943
  a(5,5)=20356
  
end if  
    call MPI_Bcast(n,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
do k=0,n-1,1
           
           ! /* gathering the result ,and then broacasting to each processor */
          do i=0,n-1,1
             call MPI_Bcast(a(k,i),1,MPI_real,0,MPI_COMM_WORLD,ierr)
          end do
         
                                                                                                            
          do i = k+myid,n-1,numprocs
        
                do j = 0 ,k-1,1         
                   g(i,j)=a(i,j)
                end do
                if (i==k)then
            
                   do j=k,n-1,1
                     g(i,j)= a(i,j)/sqrt(a(k,k))
                   end do
            
                else
            
                  g(i,k)=a(i,k)/sqrt(a(k,k))
                  do  j=k+1,n-1,1
                    g(i,j)=a(i,j)-a(i,k)*a(k,j)/a(k,k)
                  end do
                end if
          end do
         !/* use the Cholersky Algorithm */
          do i = k+myid,n-1,1  
             ! do j=0,5,1
              call MPI_Send(g(i,0:5:1),n,MPI_DOUBLE_PRECISION,0,99,MPI_COMM_WORLD,ierr)
              !end do
         
          end do

      if(myid.EQ.0)then
        
            do  j=0,numprocs-1,1
            
               do i=k+j,n-1,1
                  
                     call  MPI_Recv(a(i,0:5:1),n,MPI_DOUBLE_PRECISION,j,99,MPI_COMM_WORLD,status,ierr)
                 
   
                end do
             end do
           
          end if
    end do

    if (myid.EQ.0)then
        do i=0,5,1
             do j=0,i-1,1
               print*,a(i,j)
              end do
             do j=i,5,1
               print*,a(i,j)
             end do         
        end do  
         !/* output the result */
    end if
    call MPI_FINALIZE(ierr)  !/* end of the program */
end program

错误显示
job aborted:
rank: node: exit code[: error message]
0: xp-b304-a1.ascl.jlu.edu.cn: 1: Fatal error in MPI_Send: Other MPI error, error stack:
MPI_Send(173): MPI_Send(buf=0012FEB8, count=6, MPI_DOUBLE_PRECISION, dest=0, tag=99, MPI_COMM_WORLD) failed
MPID_Send(53): DEADLOCK: attempting to send a message to the local process without a prior matching receive

不知道怎么改了。快崩溃了。请教高手。谢谢。

onesupeng

我运行了一下你的代码，程序可以运行，但是算出来结果是错的。
我觉得你这个问题可能是机器权限设置什么的有些问题