Matrix Fortran和MPI中的Jacobi迭代

我正试图用jacobi迭代法求解ax=b，我的串行代码运行良好，但MPI版本甚至无法运行。有人能帮我吗

连载

program jacobis

implicit none

integer, parameter :: n=10
integer :: i,j,k,ni,s,seed
double precision :: tol,t1,t2,sig
double precision, dimension(0:n-1,0:n-1) :: A
double precision, dimension(0:n-1) :: B, x, xb, buff

ni=1000

seed=time()
call srand(seed)

do i=0, n-1
  do j=0, n-1
    A(i,j)=rand(0)
    B(i)=rand(0)
  end do
end do

do i = 0, n-1
 A(i,i) = sum(A(i,:)) + 1
enddo

!do i=0,n-1
 !A(i,i)=4
!end do  

print *, "a", A
print *, "b", B

x=B
call cpu_time(t1)
do k=1,ni
 xb=x
 do i=0,n-1
    s=0
    do j=0,n-1
    if (j/=i) then
         s=s+A(i,j)*xb(j)
        endif
    end do
    x(i)=(B(i)-s)/A(i,i) 

   sig=(x(i)-xb(i))*(x(i)-xb(i))
   tol=tol+sig
   tol=sqrt(tol)
 end do


 print *, "x", x

 !print *, "tol=", tol

 print *, "iter =",k

 if (tol<1.000001) EXIT
 if (k==(ni-1)) then
    print *, "Numero Maximo de Iteracoes" 
    EXIT
 endif
end do

 call cpu_time(t2)
 print *, "t=",t2-t1


end

程序jacobis
隐式无
整数，参数：：n=10
整数：：i，j，k，ni，s，种子
双精度：tol、t1、t2、sig
双精度，尺寸（0:n-1,0:n-1）：：A
双精度，尺寸（0:n-1）：：B、x、xb、buff
ni=1000
种子=时间（）
调用srand（seed）
i=0，n-1吗
do j=0，n-1
A（i，j）=兰特（0）
B（i）=兰特（0）
结束
结束
i=0，n-1吗
A（i，i）=和（A（i，：）+1
结束循环
!i=0，n-1吗
!A（i，i）=4
!结束
打印*，“a”，a
打印*，“b”，b
x=B
呼叫cpu_时间（t1）
do k=1，ni
xb=x
i=0，n-1吗
s=0
do j=0，n-1
如果（j/=i）那么
s=s+A（i，j）*xb（j）
恩迪夫
结束
x（i）=（B（i）-s）/A（i，i）
sig=（x（i）-xb（i））*（x（i）-xb（i））
tol=tol+sig
tol=sqrt（tol）
结束
打印*，“x”，x
!打印*，“tol=”，tol
打印*，“iter=”，k
如果（tol我可以看到您的程序有几个问题。您包含的错误消息表明此调用中未分配接收缓冲区：

CALL MPI_ALLGATHER(B_local, m, MPI_DOUBLE, x_temp1, m, MPI_DOUBLE, MPI_COMM_WORLD)

在此上下文中使用之前，需要分配接收缓冲区Array
x_temp1

修复此问题只会让您走得更远，并且您将得到一个信息较少的分段错误。在MPI实现中查找
MPI\u AllGather
的正确用法将非常有用。大多数MPI例程的末尾都有一个整数错误状态参数：

MPI_ALLGATHER(SENDBUF, SENDCOUNT, SENDTYPE, RECVBUF, RECVCOUNT,
        RECVTYPE, COMM, IERROR)
    <type>    SENDBUF (*), RECVBUF (*)
    INTEGER    SENDCOUNT, SENDTYPE, RECVCOUNT, RECVTYPE, COMM,
    INTEGER    IERROR

MPI_ALLGATHER（SENDBUF、SENDCOUNT、SENDTYPE、RECVBUF、RECVCOUNT、，
记录类型、通信、IERROR）
SENDBUF（*），RECVBUF（*）
整数SENDCOUNT、SENDTYPE、RECVCOUNT、RECVTYPE、COMM、，
整数误差

这应该会让你开始分配任务。确保分配所有你使用的
可分配的
数组，并为你的MPI实现和编译器手册使用适当的文档。
我已经解决了这个问题，现在它正确地计算了迭代，并通过使用相同矩阵的串行程序进行了验证。这是一个allo阳离子和指数问题。由于前面的答案，非常有用

program jacobis

use mpi
implicit none

integer, parameter :: n=1000
integer :: i_local,i_global,j,k,ni,s,m,seed
double precision :: tol,t,t2,sig
double precision, dimension(:,:), ALLOCATABLE :: A_local
double precision, dimension(:), ALLOCATABLE :: B_local, x_local, x_temp1,x_old,x_new, buff
INTEGER, DIMENSION (MPI_STATUS_SIZE) :: STATUS
integer :: rank,procs,tag,ierror


CALL MPI_INIT(ierror)
CALL MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierror)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD,procs,ierror)

ni=1000
m=n/procs

ALLOCATE (A_local(0:n-1,0:n-1))
ALLOCATE (B_local(0:n-1))
ALLOCATE (x_local(0:n-1))
ALLOCATE (x_temp1(0:n-1))
ALLOCATE (x_new(0:n-1))

!A_local=23
!B_local=47

seed=time()
call srand(seed)

do k=0, n-1
 do j=0, n-1
    A_local(k,j)=rand(0)
    B_local(k)=rand(0)
 end do
end do

do i_global = 0, m-1
 A_local(i_global,i_global) = sum(A_local(i_global,:)) + n
enddo

CALL MPI_ALLGATHER(B_local, m, MPI_DOUBLE, x_temp1, m, MPI_DOUBLE, MPI_COMM_WORLD,ierror)

x_new=x_temp1

print *, "a", A_local
print *, "b", B_local


t=mpi_wtime()
do k=1,ni
 x_old=x_new
 do i_local=0,m-1
    i_global=i_local+rank*m 
    !x_local(i_local)=b_local(i_local)
    s=0
    do j=0,n-1
    if (j/=i_local) then
         s=s+A_local(i_local,j)*x_old(j)
        endif
    end do
    x_local(i_local)=(B_local(i_local)-s)/A_local(i_local,i_global) 
 end do
 CALL MPI_ALLGATHER(x_local,m, MPI_DOUBLE, x_new, m, MPI_DOUBLE, MPI_COMM_WORLD,ierror)
 do j=0,n-1
   sig=(x_new(j)-x_old(j))*(x_new(j)-x_old(j))
   tol=tol+sig
   tol=sqrt(tol)
 end do

 print *, "x", x_local

 print *, "tol=", tol

 print *, "iter =",k

 if (tol<1.01) EXIT
 if (k==(ni-1)) then
    print *, "Numero Maximo de Iteracoes" 
    EXIT
 endif
end do

 t2=mpi_wtime()-t;
 print *, "t=",t2

CALL MPI_FINALIZE(ierror)
end

程序jacobis
使用mpi
隐式无
整数，参数：：n=1000
整数：：i_局部、i_全局、j、k、ni、s、m、种子
双精度：tol、t、t2、sig
双精度，维度（：，：），可分配：：A_local
双精度，维度（：），可分配：：B_local，x_local，x_temp1，x_old，x_new，buff
整数，维度（MPI\U状态\U大小）：：状态
整数：：秩、过程、标记、ierror
调用MPI_INIT（ierror）
调用MPI_COMM_RANK（MPI_COMM_WORLD，RANK，ierror）
调用MPI_COMM_SIZE（MPI_COMM_WORLD、procs、ierror）
ni=1000
m=n/procs
分配（本地（0:n-1,0:n-1））
分配（B_本地（0:n-1））
分配（x_本地（0:n-1））
分配（x_temp1（0:n-1））
分配（x_新（0:n-1））
！A_local=23
！B_local=47
种子=时间（）
调用srand（seed）
do k=0，n-1
do j=0，n-1
A_局部（k，j）=兰德（0）
B_local（k）=兰特（0）
结束
结束
i_全局=0，m-1吗
A_local（i_global，i_global）=和（A_local（i_global，：）+n
结束循环
调用MPI_ALLGATHER（本地、m、MPI_DOUBLE、x_temp1、m、MPI_DOUBLE、MPI_COMM_WORLD、ierror）
x_new=x_temp1
打印*，“a”，a_本地
打印*，“b”，b_本地
t=mpi_wtime（）
do k=1，ni
x_旧=x_新
i_local=0，m-1吗
i_global=i_local+rank*m
！x_local（i_local）=b_local（i_local）
s=0
do j=0，n-1
如果（j/=i_局部），则
s=s+A_局部（i_局部，j）*x_旧（j）
恩迪夫
结束
x_local（i_local）=（B_local（i_local）-s）/A_local（i_local，i_global）
结束
调用MPI_ALLGATHER（x_local、m、MPI_DOUBLE、x_new、m、MPI_DOUBLE、MPI_COMM_WORLD、ierror）
do j=0，n-1
sig=（x_新（j）-x_旧（j））*（x_新（j）-x_旧（j））
tol=tol+sig
tol=sqrt（tol）
结束
打印*，“x”，x_本地
打印*，“tol=”，tol
打印*，“iter=”，k
如果（tol您的程序有严重问题，您可能会得到错误的结果。变量s声明为整数，而它被分配为非整数值。重新声明为双精度以获得正确的结果。（专为复制此代码的人发布）
在赋值表达式的LHS上仍然有未分配的数组。您使用的编译器是什么？使用
-O0-g-C
标志进行编译，以获取错误消息，并提供更多关于错误的提示。因为这是一个类赋值，我们无法调试您的代码，但只能给出错误和如何继续的提示。祝您好运。Gl如果您已经解决了问题。请注意，您可以单击复选标记以接受任一答案为正确答案。请考虑单击@IRO bot答案上的复选标记，这有助于您解决问题（而不是您自己根据他的建议提出的解决方案）。
program jacobis

use mpi
implicit none

integer, parameter :: n=1000
integer :: i_local,i_global,j,k,ni,s,m,seed
double precision :: tol,t,t2,sig
double precision, dimension(:,:), ALLOCATABLE :: A_local
double precision, dimension(:), ALLOCATABLE :: B_local, x_local, x_temp1,x_old,x_new, buff
INTEGER, DIMENSION (MPI_STATUS_SIZE) :: STATUS
integer :: rank,procs,tag,ierror


CALL MPI_INIT(ierror)
CALL MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierror)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD,procs,ierror)

ni=1000
m=n/procs

ALLOCATE (A_local(0:n-1,0:n-1))
ALLOCATE (B_local(0:n-1))
ALLOCATE (x_local(0:n-1))
ALLOCATE (x_temp1(0:n-1))
ALLOCATE (x_new(0:n-1))

!A_local=23
!B_local=47

seed=time()
call srand(seed)

do k=0, n-1
 do j=0, n-1
    A_local(k,j)=rand(0)
    B_local(k)=rand(0)
 end do
end do

do i_global = 0, m-1
 A_local(i_global,i_global) = sum(A_local(i_global,:)) + n
enddo

CALL MPI_ALLGATHER(B_local, m, MPI_DOUBLE, x_temp1, m, MPI_DOUBLE, MPI_COMM_WORLD,ierror)

x_new=x_temp1

print *, "a", A_local
print *, "b", B_local


t=mpi_wtime()
do k=1,ni
 x_old=x_new
 do i_local=0,m-1
    i_global=i_local+rank*m 
    !x_local(i_local)=b_local(i_local)
    s=0
    do j=0,n-1
    if (j/=i_local) then
         s=s+A_local(i_local,j)*x_old(j)
        endif
    end do
    x_local(i_local)=(B_local(i_local)-s)/A_local(i_local,i_global) 
 end do
 CALL MPI_ALLGATHER(x_local,m, MPI_DOUBLE, x_new, m, MPI_DOUBLE, MPI_COMM_WORLD,ierror)
 do j=0,n-1
   sig=(x_new(j)-x_old(j))*(x_new(j)-x_old(j))
   tol=tol+sig
   tol=sqrt(tol)
 end do

 print *, "x", x_local

 print *, "tol=", tol

 print *, "iter =",k

 if (tol<1.01) EXIT
 if (k==(ni-1)) then
    print *, "Numero Maximo de Iteracoes" 
    EXIT
 endif
end do

 t2=mpi_wtime()-t;
 print *, "t=",t2

CALL MPI_FINALIZE(ierror)
end