End of file
Contents
Index



F 4.7.2 The Conjugate Gradient Method


      SUBROUTINE CG (A, N, IA, Y, X, IERR, D, G, AMULD)
C
C*****************************************************************
C                                                                *
C  This SUBROUTINE solves a linear system of equations AX = Y    *
C  using the conjugate gradient method.                          *
C                                                                *
C  ASSUMPTION:                                                   *
C  ===========                                                   *
C          A must be a symmetric and positive definite N by N    *
C          matrix                                                *
C                                                                *
C  Input PARAMETERS:                                             *
C  =================                                             *
C  A     : 2-dim. array  A(1:IA, 1:N), containing the NxN system *
C          matrix A. Only the upper triangle of A shall be used  *
C          and we do not check whether A is indeed symmetric.    *
C  N     : order of the system                                   *
C  IA    : leading dimension of A, as specified in the calling   *
C          program                                               *
C  Y     : N-vector Y(1:N), the right hand side                  *
C                                                                *
C  HILFSPARAMETER:                                               *
C  ===============                                               *
C  D     : N-vector D(1:N)                                       *
C  G     : N-vector G(1:N)                                       *
C  AMULD : N-vector AMULD(1:N) containing  A*D                   *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  X     : N-vector X(1:N), the solution of the linear system    *
C  IERR  : error parameter:                                      *
C            = 0, if the denominator of ALPHA vanishes           *
C            = 1, all is ok, the solution has been found         *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Required subroutines: MACHPD                                  *
C                                                                *
C*****************************************************************
C                                                                *
C  Author    : Gisela Engeln-Müllges                             *
C  Date      : 02.12.1991                                        *
C  Source    : FORTRAN  77                                       *
C                                                                *
C*****************************************************************
C
C  Declarations
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
      DOUBLE PRECISION A(1:IA, 1:N), Y(1:N), X(1:N), D(1:N), G(1:N),
     +                 AMULD(1:N)
C
C  Compute the machine constant
C
      FMACHP = 1.0D0
   10 FMACHP = FMACHP * 0.5D0
      IF(MACHPD(1.0D0+FMACHP) .EQ. 1) GOTO 10
      FMACHP = 8.0D0 * FMACHP
C
C  Initialize the auxiliary vectors  D and G and use
C  the zero vector for a start
C
      DO 20 I=1,N
        HELP = Y(I)
        D(I) = HELP
        G(I) = -HELP
        X(I) = 0.0D0
   20 CONTINUE
C
C  Perform N conjugate gradient steps
C
      DO 30 K=0,N-1
C
C       Initialize numerator and denominator for ALPHA
C
        XNUM = 0.0D0
        DENOM = 0.0D0
C
C       update ALPHA according to:
C       ALPHA = -(D(TRANSP)*G) /A*D(TRANSP)*(A*D))
C
        DO 40 I=1,N
          XNUM = XNUM + D(I) * G(I)
          HELP = 0.0D0
          DO 50 J=1,I-1
            HELP = HELP + A(J,I) * D(J)
   50     CONTINUE
          DO 60 J=I,N
            HELP = HELP + A(I,J) * D(J)
   60     CONTINUE
          AMULD(I) = HELP
          DENOM = DENOM + D(I) * HELP
   40   CONTINUE
C
C       check whether the denominator of  ALPHA  is zero
C
        IF(DABS(DENOM) .LT. FMACHP) THEN
          IERR = 0
          RETURN
        ENDIF
        ALPHA = -XNUM / DENOM
C
C       update  X := X + ALPHA * D
C
        DO 70 I=1,N
          X(I) = X(I) + ALPHA * D(I)
   70   CONTINUE
\hbox{\JDhspace\verb`
C
C       update  G := G + ALPHA * A * D
C       and find its norm: NORM;
C       we also check whether X is a good enough approximation
C       of the solution so that computations can be stopped
C       with less than  N  CG-steps.
C
        GNORM = 0.0D0
        DO 80 I=1,N
          G(I) = G(I) + ALPHA * AMULD(I)
          GNORM = GNORM + G(I)*G(I)
   80   CONTINUE
        IF(GNORM .LT. FMACHP) THEN
          IERR = 1
          RETURN
        ENDIF
C
C       Calculate a new  BETA :
C
C       BETA = (G(TRANSP)*(A*D)) / (D(TRANSP)*(A*D))
C
        XNUM = 0.0D0
        DO 90 I=1,N
          XNUM = XNUM + G(I) * AMULD(I)
   90   CONTINUE
        BETA = XNUM / DENOM
C
C       update  D := -G + BETA * D
C
        DO 100 I=1,N
          D(I) = -G(I) + BETA * D(I)
  100   CONTINUE
   30 CONTINUE
      IERR = 1
C
      RETURN
      END


Begin of file
Contents
Index