End of file
Contents
Index



F 4.12.1 Systems with Five-Diagonal Matrices


      SUBROUTINE FDIAG (N,DL2,DL1,DM,DU1,DU2,RS,X,MARK)
C
C*****************************************************************
C                                                                *
C     Solving a system of linear equations                       *
C                      A * X = RS                                *
C     with a five-diagonal, strongly nonsingular matrix A via    *
C     Gauss algorithm without pivoting.                          *
C     The matrix A is given as five N-vectors DL2, DL1, DM, DU1  *
C     and DU2. The linear system has the form:                   *
C                                                                *
C     DM(1)*X(1)+DU1(1)*X(2)+DU2(1)*X(3)             = RS(1)     *
C     DL1(2)*X(1)+DM(2)*X(2)+DU1(2)*X(3)+DU2(2)*X(4) = RS(2)     *
C                                                                *
C     DL2(I)*X(I-2)+DL1(I)*X(I-1)+                               *
C           +DM(I)*X(I)+DU1(I)*X(I+1)+DU2(I)*X(I+2)  = RS(I)     *
C            for I = 3, ..., N - 2, and                          *
C                                                                *
C     DL2(N-1)*X(N-3)+DL1(N-1)*X(N-2)+                           *
C             +DM(N-1)*X(N-1)+DU1(N-1)+X(N)          = RS(N-1)   *
C     DL2(N)*X(N-2)+DL1(N)*X(N-1)+DM(N)*X(N)         = RS(N)     *
C                                                                *
C                                                                *
C                                                                *
C     INPUT PARAMETERS:                                          *
C     =================                                          *
C     N     : number of equations; N > 3                         *
C     DL2   : N-vector DL2(1:N); second lower co-diagonal        *
C             DL2(3), DL2(4), ... , DL2(N)                       *
C     DL1   : N-vector DL1(1:N); lower co-diagonal               *
C             DL1(2), DL1(3), ... , DL1(N)                       *
C     DM    : N-vector DM(1:N); main diagonal                    *
C             DM(1), DM(2), ... , DM(N)                          *
C     DU1   : N-vector DU1(1:N); upper co-diagonal               *
C             DU1(1), DU1(2), ... , DU1(N-1)                     *
C     DU2   : N-vector DU2(1:N); second upper co-diagonal        *
C             DU2(1), DU2(2), ... , DU2(N-2)                     *
C     RS    : N-vector RS(1:N); the right hand side of the       *
C             linear system                                      *
C                                                                *
C                                                                *
C     OUTPUT PARAMETERS:                                         *
C     ==================                                         *
C     DL2   :) overwritten with auxiliary vectors defining the   *
C     DL1   :) factorization of the cyclically tridiagonal       *
C     DM    :) matrix A                                          *
C     DU1   :)                                                   *
C     DU2   :)                                                   *
C     X     : N-vector X(1:N); containing the solution of the    *
C             the system of equations                            *
C     MARK  : error parameter                                    *
C             MARK=-1 : condition N > 3 is not satisfied         *
C             MARK= 0 : numerically the matrix A is not strongly *
C                       nonsingular                              *
C             MARK= 1 : everything is o.k.                       *
C                                                                *
C     NOTE: if MARK = 1, the determinant of A is given by:       *
C                DET A = DM(1) * DM(2) * ... * DM(N)             *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: FDIAGP, FDIAGS, MACHPD                  *
C                                                                *
C*****************************************************************
C                                                                *
C  author   : Gisela Engeln-Muellges                             *
C  date     : 05.06.1988                                         *
C  source   : FORTRAN 77                                         *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION DL1(1:N),DL2(1:N),DM(1:N)
      DOUBLE PRECISION DU1(1:N),DU2(1:N),RS(1:N),X(1:N)
      MARK = -1
      IF (N .LT. 4) RETURN
C
C  Factor the matrix A
C
      CALL FDIAGP(N,DL2,DL1,DM,DU1,DU2,MARK)
C
C  if MARK = 1, update and bachsubstitute
C
      IF (MARK .EQ. 1) THEN
           CALL FDIAGS(N,DL2,DL1,DM,DU1,DU2,RS,X)
      END IF
      RETURN
      END
C
C

      SUBROUTINE FDIAGP (N,DL2,DL1,DM,DU1,DU2,MARK)
C
C*****************************************************************
C                                                                *
C     Factor a five-diagonal, strongly nonsingular matrix A      *
C     that is defined by the five N-vectors DL2, DL1, DM, DU1    *
C     and DU2, into its triangular factors  L * R  by applying   *
C     Gaussian elimination specialized for five-diagonal matrices*
C     (without pivoting).                                        *
C                                                                *
C                                                                *
C     INPUT PARAMETERS:                                          *
C     =================                                          *
C     N     : number of equations; N > 3                         *
C     DL2   : N-vector DL2(1:N); second lower co-diagonal        *
C             DL2(3), DL2(4), ... , DL2(N)                       *
C     DL1   : N-vector DL1(1:N); lower co-diagonal               *
C             DL1(2), DL1(3), ... , DL1(N)                       *
C     DM    : N-vector DM(1:N); main diagonal                    *
C             DM(1), DM(2), ... , DM(N)                          *
C     DU1   : N-vector DU1(1:N); upper co-diagonal               *
C             DU1(1), DU1(2), ... , DU1(N-1)                     *
C     DU2   : N-vector DU2(1:N); second upper co-diagonal        *
C             DU2(1), DU2(2), ... , DU2(N-2)                     *
C                                                                *
C                                                                *
C     OUTPUT PARAMETERS:                                         *
C     ==================                                         *
C     DL2   :) overwritten with auxiliary vectors that define    *
C     DL1   :) the factors of the five-diagonal matrix A;        *
C     DM    :) the three co-diagonals of the lower triangular    *
C     DU1   :) matrix L are stored in the vectors DL2, DL1 and   *
C     DU2   :) DM. The two co-diagonals of the unit upper        *
C              triangular matrix R are stored in the vectors DU1 *
C              and DU2, its diagonal elements each have the      *
C              value  1.                                         *
C     MARK  : error parameter                                    *
C             MARK=-1 : condition N > 3 is violated              *
C             MARK= 0 : numerically the matrix is not strongly   *
C                       nonsingular                              *
C             MARK= 1 : everything is o.k.                       *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: MACHPD                                  *
C                                                                *
C*****************************************************************
C                                                                *
C  author   : Gisela Engeln-Muellges                             *
C  date     : 05.06.1988                                         *
C  source   : FORTRAN 77                                         *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION DL2(1:N),DL1(1:N),DM(1:N),DU1(1:N),DU2(1:N)
C
C  testing whether N > 3
C
      MARK = -1
      IF (N .LT. 4) RETURN
C
C  calculating the machine constant
C
      FMACHP = 1.0D0
   10 FMACHP = 0.5D0 * FMACHP
      IF (MACHPD(1.0D0+FMACHP) .EQ. 1) GOTO 10
      FMACHP = FMACHP * 2.0D0
C
C  determining relative error bounds
C
      EPS = 4.0D0 * FMACHP
C
C  initializing the undefined vector components
C
      DL2(1) = 0.0D0
      DL2(2) = 0.0D0
      DL1(1) = 0.0D0
      DU1(N) = 0.0D0
      DU2(N-1) = 0.0D0
      DU2(N) = 0.0D0
C
C  factoring the matrix A while checking for strong nonsingularity
C  for N=1, 2
C
      ROW = DABS(DM(1)) + DABS(DU1(1)) + DABS(DU2(1))
      IF (ROW .EQ. 0.0D0) THEN
         MARK = 0
         RETURN
      ENDIF
      D = 1.0D0/ROW
      IF (DABS(DM(1))*D .LE. EPS) THEN
         MARK = 0
         RETURN
      ENDIF
      DU1(1) = DU1(1)/DM(1)
      DU2(1) = DU2(1)/DM(1)
      ROW = DABS(DL1(2)) + DABS(DM(2)) + DABS(DU1(2)) + DABS(DU2(2))
      IF (ROW .EQ. 0.0D0) THEN
         MARK = 0
         RETURN
      ENDIF
      D = 1.0D0/ROW
      DM(2) = DM(2)-DL1(2)*DU1(1)
      IF (DABS(DM(2))*D .LE. EPS) THEN
         MARK = 0
         RETURN
      ENDIF
      DU1(2) = (DU1(2)-DL1(2)*DU2(1))/DM(2)
      DU2(2) = DU2(2)/DM(2)
C
C  factoring A while checking for strong nonsingularity of A
C
      DO 20 I=3,N,1
         ROW = DABS(DL2(I))+DABS(DL1(I))+DABS(DM(I))+
     +         DABS(DU1(I))+DABS(DU2(I))
         IF (ROW .EQ. 0.0D0) THEN
            MARK = 0
            RETURN
         ENDIF
         D = 1.0D0/ROW
         DL1(I) = DL1(I)-DL2(I)*DU1(I-2)
         DM(I) = DM(I)-DL2(I)*DU2(I-2)-DL1(I)*DU1(I-1)
         IF (DABS(DM(I))*D .LE. EPS) THEN
            MARK = 0
            RETURN
         ENDIF
         IF (I .LT. N) THEN
            DU1(I) = (DU1(I)-DL1(I)*DU2(I-1))/DM(I)
         ENDIF
         IF (I .LT. (N-1)) THEN
            DU2(I) = DU2(I)/DM(I)
         ENDIF
   20 CONTINUE
      MARK = 1
      RETURN
      END
C
C

      SUBROUTINE FDIAGS (N,DL2,DL1,DM,DU1,DU2,RS,X)
C
C*****************************************************************
C                                                                *
C     Solving a linear system of equations                       *
C                A * X = RS                                      *
C     for a five-diagonal, strongly nonsingular matrix A, once   *
C     the factor matrices L * R have been calculated by          *
C     SUBROUTINE FDIAGP.                                         *
C     Here they are used as input arrays and                     *
C     they are stored in the five N-vectors DL2, DL1, DM, DU1    *
C     and DU2.                                                   *
C                                                                *
C                                                                *
C     INPUT PARAMETERS:                                          *
C     =================                                          *
C     N     : number of equations; N > 3                         *
C     DL2   : N-vector DL2(1:N); ) lower triangular matrix L     *
C     DL1   : N-vector DL1(1:N); ) including the diagonal        *
C     DM    : N-vector DM(1:N);  ) elements                      *
C                                                                *
C     DU1   : N-vector DU1(1:N); ) unit upper triangular matrix  *
C     DU2   : N-vector DU2(1:N); ) R without its unit diagonal   *
C                                   elements                     *
C     RS    : N-vector RS1(1:N); right side of the linear system *
C                                                                *
C                                                                *
C     OUTPUT PARAMETERS:                                         *
C     ==================                                         *
C     X     : N-vector X(1:N); the solution of the linear system *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: none                                    *
C                                                                *
C*****************************************************************
C                                                                *
C  author   : Gisela Engeln-Muellges                             *
C  date     : 05.06.1988                                         *
C  source   : FORTRAN 77                                         *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION DL2(1:N),DL1(1:N),DM(1:N)
      DOUBLE PRECISION DU1(1:N),DU2(1:N),RS(1:N),X(1:N)
C
C  updating
C
      RS(1)=RS(1)/DM(1)
      RS(2)=(RS(2)-DL1(2)*RS(1))/DM(2)
      DO 10 I=3,N
         RS(I)=(RS(I)-DL2(I)*RS(I-2)-DL1(I)*RS(I-1))/DM(I)
   10 CONTINUE
C
C  backsubstitution
C
      X(N)=RS(N)
      X(N-1)=RS(N-1)-DU1(N-1)*X(N)
      DO 20 I=N-2,1,-1
         X(I)=RS(I)-DU1(I)*X(I+1)-DU2(I)*X(I+2)
   20 CONTINUE
      RETURN
      END


Begin of file
Contents
Index