2

私はFortranで双共役勾配アルゴリズムに取り組んでおり、Saad、Y.「スパース線形システムの反復法」(プレーンなBiCG法)のアルゴリズムに従って完全にコーディングしています。ただし、必要な反復回数に収束しておらず、正しい結果を返していません。

アルゴリズムは、ウィキペディアの「事前調整されていないバージョン」(http://en.wikipedia.org/wiki/Biconjugate_gradient_method#Unpreconditioned_version_of_the_algorithm)のように提供されています。

私はまだFortranに比較的慣れていないので、指定どおりにコーディングされていることがわかっている限り、これが期待どおりに動作しない理由がわかりません。誰かが非正統的なコードやアルゴリズムの誤りを見つけたら、私はとても感謝しています!

簡単にするために、テストマトリックスを含めました。

    !
    !////////////////////////////////////////////////////////////////////////
    !
    !      BiCG_main.f90
    !      Created: 19 February 2013 12:01
    !      By: Robin  Fox  
    !
    !////////////////////////////////////////////////////////////////////////
    !
    PROGRAM bicg_main
    !
    IMPLICIT NONE 
    !-------------------------------------------------------------------
    ! Program to implement the Bi-Conjugate Gradient method
    ! follows algorithm in Saad
    !-------------------------------------------------------------------
    !
    COMPLEX(KIND(0.0d0)), DIMENSION(:,:), ALLOCATABLE       ::A
    COMPLEX(KIND(0.0d0)), DIMENSION(:), ALLOCATABLE         ::b
    COMPLEX(KIND(0.0d0)), DIMENSION(:), ALLOCATABLE         ::x0, x0s
    COMPLEX(KIND(0.0d0)), DIMENSION(:), ALLOCATABLE         ::x, xs
    COMPLEX(KIND(0.0d0)), DIMENSION(:), ALLOCATABLE         ::p, ps 
    COMPLEX(KIND(0.0d0))                                    ::alpha, rho0, rho1, r_rs
    COMPLEX(KIND(0.0d0)), DIMENSION(:), ALLOCATABLE         ::r,rs, res_vec
    COMPLEX(KIND(0.0d0)), DIMENSION(:), ALLOCATABLE         ::Ax, ATx
    COMPLEX(KIND(0.0d0)), DIMENSION(:), ALLOCATABLE         ::Ap, Aps
    COMPLEX(KIND(0.0d0))                                    ::beta
    !
    REAL(KIND(0.0d0))                                       ::tol,res, n2b, n2r0, rel_res
    !
    INTEGER                                                 ::n,i,j,k, maxit
    !//////////////////////////////////////////////////////////////////////// 

    !----------------------------------------------------------   
    n=2
    ALLOCATE(A(n,n))
    ALLOCATE(b(n))

    A(1,1)=CMPLX(-0.73492,7.11486)
    A(1,2)=CMPLX(0.024839,4.12154)
    A(2,1)=CMPLX(0.274492957,3.7885537)
    A(2,2)=CMPLX(-0.632557864,1.95397735)

    b(1)=CMPLX(0.289619736,0.895562183)
    b(2)=CMPLX(-0.28475616,-0.892163111)

    !---------------------------------------------------------- 

    ALLOCATE(x0(n))
    ALLOCATE(x0s(n))

    !Use all zeros initial guess
    x0(:)=CMPLX(0.0d0,0.0d0)
    DO i=1,n
       x0s(i)=CONJG(x0(i))
    END DO 

    ALLOCATE(Ax(n))
    ALLOCATE(ATx(n))
    ALLOCATE(x(n))
    ALLOCATE(xs(n))

    ! Multiply matrix A with vector x0
    DO i=1,n
       Ax(i)=CMPLX(0.0,0.0)
       DO j=1,n
          Ax(i)=Ax(i)+A(i,j)*x0(j) !==Ax=A*x0
       END DO 
    END DO    

    ! Multiply matrix A^T with vector x0
    DO i=1,n
       ATx(i)=CMPLX(0.0,0.0)
       DO j=1,n
          ATx(i)=ATx(i)+CONJG(A(j,i))*x0s(j) !==A^Tx=A^T*x0
       END DO 
    END DO    

    res=0.0d0
    n2b=0.0d0
    x=x0

    ALLOCATE(r(n))
    ALLOCATE(rs(n))
    ALLOCATE(p(n))
    ALLOCATE(ps(n))

    !Initialise
    DO i=1,n
       r(i)=b(i)-Ax(i) 
       rs(i)=CONJG(b(i))-ATx(i)
       p(i)=r(i) !p0=r0
       ps(i)=rs(i) !p0s=r0s
    END DO 

    DO i=1,n
       n2b=n2b+(b(i)*CONJG(b(i)))
       res=res+(r(i)*CONJG(r(i))) !== inner prod(r,r)
    END DO 
    n2b=SQRT(n2b)
    res=SQRT(res)/n2b

    !Check that inner prod(r,rs) =/= 0
    n2r0=0.0d0
    DO i=1,n
       n2r0=n2r0+r(i)*CONJG(rs(i))
    END DO 

    IF (n2r0==0) THEN 
       res=1d-20 !set tol so that loop doesn't run (i.e. already smaller than tol)
       PRINT*, "Inner product of r, rs == 0"
    END IF 
    WRITE(*,*) "n2r0=", n2r0

    !---------------------------------------------------------- 
    ALLOCATE(Ap(n))
    ALLOCATE(Aps(n))
    ALLOCATE(res_vec(n))

    tol=1d-6
    maxit=50 !for n=720

    k=0
    !Main loop:
    main: DO WHILE ((res>tol).AND.(k<maxit))

       k=k+1
       ! Multiply matrix A with vector p
       DO i=1,n
          Ap(i)=CMPLX(0.0,0.0)
          DO j=1,n
             Ap(i)=Ap(i)+A(i,j)*p(j)
          END DO 
       END DO    

       ! Multiply matrix A^T with vector p
       ! N.B. transpose is also conjg.
       DO i=1,n
          Aps(i)=CMPLX(0.0,0.0)
          DO j=1,n
             Aps(i)=Aps(i)+CONJG(A(j,i))*ps(j)
          END DO 
       END DO  

       rho0=CMPLX(0.0d0,0.0d0)
       DO i=1,n
          rho0=rho0+(r(i)*CONJG(rs(i)))
       END DO 
       WRITE(*,*) "rho0=", rho0

       rho1=CMPLX(0.0d0,0.0d0)
       DO i=1,n
          rho1=rho1+(Ap(i)*CONJG(ps(i)))
       END DO 
       WRITE(*,*) "rho1=", rho1

       !Calculate alpha:
       alpha=rho0/rho1
       WRITE(*,*) "alpha=", alpha

       !Update solution
       DO i=1,n
          x(i)=x(i)+alpha*p(i)
       END DO    

       !Update residual:
       DO i=1,n
          r(i)=r(i)-alpha*Ap(i)
       END DO 

       !Update second residual:
       DO i=1,n
          rs(i)=rs(i)-alpha*Aps(i)
       END DO 

       !Calculate beta:
       r_rs=CMPLX(0.0d0,0.0d0)
       DO i=1,n
          r_rs=r_rs+(r(i)*CONJG(rs(i)))
       END DO 
       beta=r_rs/rho0

       !Update direction vectors:
       DO i=1,n
          p(i)=r(i)+beta*p(i)
       END DO 

       DO i=1,n
          ps(i)=rs(i)+beta*ps(i)
       END DO 

       !Calculate residual for convergence check
    !   res=0.0d0
    !   DO i=1,n
    !      res=res+(r(i)*CONJG(r(i))) !== inner prod(r,r)
    !   END DO 
    !---------------------------------------------------------- 
       !Calculate updated residual "res_vec=b-A*x" relative to current x
       DO i=1,n
          Ax(i)=CMPLX(0.0d0, 0.0d0)
          DO j=1,n
                  Ax(i)=Ax(i)+A(i,j)*x(j)
          END DO 
       END DO   

       DO i=1,n
          res_vec(i)=b(i)-Ax(i)
       END DO 

       DO i=1,n
          rel_res=rel_res+(res_vec(i)*CONJG(res_vec(i)))
       END DO 
       res=SQRT(res)/REAL(n2b)
       WRITE(*,*) "res=",res
       WRITE(*,*) " "

    END DO main    
    !----------------------------------------------------------   
    !Output message
    IF (k<maxit) THEN 
       WRITE(*,*) "Converged in",k,"iterations"
    ELSE 
       WRITE(*,*) "STOPPED after",k, "iterations because max no. of iterations was reached"
    END IF 

    !Output solution vector:
    WRITE(*,*) "x_sol="
    DO i=1,n
       WRITE(*,*) x(i) 
    END DO  

    !----------------------------------------------------------   
    DEALLOCATE(x0,x0s, Ax, ATx, x, xs, p, ps ,r, rs, Ap, Aps, res_vec)
    DEALLOCATE(A,b)
    !
    END PROGRAM 
    !
    !////////////////////////////////////////////////////////////////////////

結果:私のスクリプトの結果は次のようになります。

      STOPPED after          50 iterations because max no. of iterations was reached
     x_sol=
     (-2.88435711452590705E-002,-0.43229898544084933     )
     ( 0.11755325208241280     , 0.73895038053993978     )

実際の結果は、MATLABの組み込みbicg.m関数を使用して次のように与えられます。

       -0.3700 - 0.6702i
        0.7295 + 1.1571i
4

1 に答える 1

3

ここにあなたのプログラムのいくつかの傷があります。それらがエラーであるかどうかは主観的なものであり、コードを変更するかどうかは完全にあなた次第です。

  1. この行で

    IF (n2r0==0) THEN 
    

    (長時間実行される可能性がある) ループの合計が正確に 0 になるかどうかをテストします。これは、浮動小数点数では常に悪い考えです。これがわからない場合は、SO に関する多くの質問をタグ付きで確認してください。これらの質問はfloating-point、fp 演算に期待するのが合理的であることを理解する上で広範囲に及ぶ不正確さから生じています。比較の左側に実数を使用し、右側に整数を使用しても問題が悪化するとは思いませんが、改善されるわけではありません。

  2. コード内の少なくとも 2 つの場所で、行列とベクトルの積を計算します。これらのループを組み込みルーチンの呼び出しに置き換えることができますmatmul(私は、あなたが確認したほどコードを詳しくチェックしていないと思います)。これにより、実際にはコードが遅くなる可能性がありますが、この段階ではそれは問題ではありません。独自のライブラリ ルーチンをローリングするのではなく、十分にテストされたライブラリ ルーチンを呼び出すと、(a) 維持/テスト/修正する必要があるコードの量が減り、(b) 適切な初回ソリューションを提供する可能性が高くなります。コードが機能するようになったら、必要に応じてパフォーマンスについて心配してください。

  3. 多くの実変数と複素変数を倍精度で宣言しますが、次のようなステートメントで初期化します。

    A(1,1)=CMPLX(-0.73492,7.11486)
    

    倍精度変数には約 15 桁の 10 進数が使用できますが、ここでは最初の 6 桁の値のみを指定します。他の桁を特定の値に設定するためにコンパイラに依存することはできません。代わりに、次のように初期化します。

    A(1,1)=CMPLX(-0.73492_dp,7.11486_dp)
    

    -0.73492これらの値は、およびに最も近い倍精度数に初期化されます7.11486。もちろん、以前に のようなものを書いている必要がdp = kind(0d0)あり、リテラル定数の精度を強制する方法は他にもありますが、これは私が通常行う方法です。組み込みモジュールを提供する最新の Fortran コンパイラを使用している場合は、 を現在の標準の にiso_fortran_env置き換えることができます。_dp_real64

  4. このコードブロック

    x0(:)=CMPLX(0.0d0,0.0d0)
    DO i=1,n
       x0s(i)=CONJG(x0(i))
    END DO 
    

    で置き換えることができます

    x0  = CMPLX(0.0d0,0.0d0)
    x0s = x0
    

    配列構文を使用して最初の配列をゼロにし、次にループして 2 番目の配列をゼロにするのは少し奇妙に思えます。CONJGを繰り返し呼び出すのはさらに奇妙に思えCONJG(0,0)==(0,0)ます。

  5. このコードブロック

      DO i=1,n
         n2b=n2b+(b(i)*CONJG(b(i)))
         res=res+(r(i)*CONJG(r(i))) !== inner prod(r,r)
      END DO 
      n2b=SQRT(n2b)
      res=SQRT(res)/n2b
    

    私が正しく理解していれば、

     n2b = sqrt(dot_product(b,b)) 
     res = sqrt(dot_product(r,r))/n2b
    

    ここであなたのコードに実際に問題があるとは思いませんが、組み込み関数を使用すると、matmul上記の場合のように、記述して維持する必要がある行数が削減されます。

他にもすぐには目立たない傷があるかもしれませんが、このロットから始めることができます。

于 2013-02-25T13:33:07.310 に答える