0

ヤコビ反復で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

MPIバージョン

program jacobis

use mpi
implicit none

integer, parameter :: n=2
integer :: i_local,i_global,j,k,ni,s,m
double precision :: tol,t,t2,sig
double precision, dimension(:,:), ALLOCATABLE :: A_local
double precision, dimension(:), ALLOCATABLE :: B_local, x_local, x_temp1,x_temp2,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=100
m=n/procs

ALLOCATE (A_local(0:n-1,0:n-1))
ALLOCATE (B_local(0:m-1))
ALLOCATE (x_temp1(0:m-1))
ALLOCATE (x_temp2(0:m-1))

A_local=0
B_local=2

do i_global=0,n-1
 A_local(i_global,i_global)=2
end do  

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

x_new=x_temp1
x_old=x_temp2

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 i_global=0,n-1
   sig=(x_new(i_global)-x_old(i_global))*(x_new(i_global)-x_old(i_global))
   tol=tol+sig
   tol=sqrt(tol)
 end do

 print *, "x", x_local

 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

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

CALL MPI_FINALIZE(ierror)
end

誰かが私が間違っていることを指摘できますか？インデックスの問題ですか？今日は本当にこれを解決する必要があります。さもないとコースを失敗します。私はこれに数え切れないほどの時間を費やし、それを機能させることができません。

よし、正しかった！セグメンテーション違反が発生しましたが、見つかりません。コードを新しいバージョンに置き換えました

4

3 に答える 3

2

あなたのプログラムには、私が見ることができるいくつかの問題があります。含まれているエラー メッセージは、この呼び出しで受信バッファーが割り当てられていないことを示しています。

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

受信バッファであるArrayx_temp1は、このコンテキストで使用する前に割り当てる必要があります。

これを修正しても、情報が少ないセグメンテーション フォールトが表示されます。MPI_AllGatherMPI 実装での正しい使用法を調べると便利です。ほとんどの MPI ルーチンには、末尾に整数のエラー ステータス引数があります。

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

これにより、課題を進めることができます。使用するすべての配列を割り当てallocatable、MPI 実装およびコンパイラ マニュアルの適切なドキュメントを使用するようにしてください。

于 2013-02-27T01:40:52.653 に答える
0

私は問題を解決しました。今では反復を正しく計算し、同じ行列を使用したシリアル プログラムによって証明されています。これは割り当てとインデックスの問題でした。以前の回答のおかげで、非常に役に立ちました。

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
于 2013-02-27T20:16:34.360 に答える