Question

我正在使用Fortran中的Bi-Conjugate Gradient算法并按照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

Answer 1

以下是您程序中的一些瑕疵。它们是否是错误在某种程度上是主观的，无论您是否修改代码，完全取决于您。

在这一行
```
IF (n2r0==0) THEN 
```
你测试一个（可能是长时间运行的）循环的结果是否合计精确到0。浮点数总是一个坏主意数字。如果您不知道这一点，请查看许多问题在这里，标签为floating-point，广泛存在理解什么是合理的期望是不精确的 f-p算术。我不认为你在左边使用实数和在比较右边使用整数会让事情变得更糟，但它并没有使它们更好。
在代码中至少有两个位置计算矩阵向量积。您可以通过调用内部matmul例程替换这些循环（我想，我没有像我确定的那样仔细检查您的代码）。这实际上可能会减慢您的代码速度，但这不是现阶段的问题。调用经过良好测试的库例程而不是自己动手（a）减少必须维护/测试/修复的代码量，（b）更有可能提供正确的首次解决方案。一旦你有代码工作，那么，如果你必须，请担心性能。
您可以使用双精度声明许多实数和复数变量用以下语句初始化它们：
```
A(1,1)=CMPLX(-0.73492,7.11486)
```
双精度变量有大约15个十进制数字，但是在这里你只提供前6个的值。您不能依赖编译器将其他数字设置为any 特别值。相反，初始化如下：
```
A(1,1)=CMPLX(-0.73492_dp,7.11486_dp)
```
将导致这些值初始化为double 最接近-0.73492和7.11486的精确数字。当然，您必须先编写类似dp = kind(0d0)的内容，并且还有其他方法可以强制执行文字常量的精度，但这是我通常这样做的方式。如果你有一个提供内在iso_fortran_env模块的现代Fortran编译器，你可以用现在标准的_dp替换_real64。
此代码块
```
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
```
使用数组语法将第一个归零是有点奇怪的数组，然后循环为零;它看起来更加奇特在CONJG。

CONJG(0,0)==(0,0)

此代码块
```
  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一样。
< / LI>
可能还有其他一些不那么明显的瑕疵，但这一批应该可以让你开始。

Fortran中的BiCG算法不能正常工作？

1 个答案: