End of file
Contents
Index



F 4.13 Linear Systems with Band Matrices


Linear Systems with Band Matrices using Pivots


      SUBROUTINE BAND(AP,LDAP,MB,N,ML,MU,B,IERR,IP)
C
C*****************************************************************
C                                                                *
C     BAND solves a linear system of equations for a banded      *
C     system matrix AP and a right hand side B. This program     *
C     should not be used if several systems with the same system *
C     matrix AP are to be solved. In this case it is better to   *
C     call BANDP below once and BANDS separately for each right  *
C     hand side.                                                 *
C                                                                *
C                                                                *
C     INPUT PARAMETERS:                                          *
C     =================                                          *
C     AP     : 2-dimensional array AP(1:LDAP,1:MB); the system   *
C              matrix in condensed form. If A denotes the        *
C              original system matrix, then                      *
C                 A(I,K)=AP(I,ML+1+K-I)                          *
C              holds for all indices I, K inside the diagonal    *
C              band of A. Thus the co-diagonals of A become      *
C              columns of AP; its rows are condensed to the left.*
C     LDAP   : leading dimension of AP as defined in the calling *
C              program                                           *
C     MB     : number of columns of AP. It is at least           *
C                 M + MIN(ML,MU) + 1                             *
C              where  M = ML+MU+1  denotes the band width of AP  *
C     N      : size of the matrix AP                             *
C     ML     : number of lower co-diagonals                      *
C     MU     : number of upper co-diagonals                      *
C     B      : N-vector  B(1:N); the right hand side             *
C                                                                *
C                                                                *
C     OUTPUT PARAMETERS:                                         *
C     ==================                                         *
C     B      : the solution (if IERR .NE. 0)                     *
C     IERR   : error parameter;                                  *
C                 IERR = 0 : no error                            *
C                 IERR.NE.0: matrix AP is numerically singular   *
C     AP     : as above; tranformed band matrix and transforma-  *
C              tion coefficients. May be used as input for BANDS *
C              in order to find solutions for additional right   *
C              hand sides.                                       *
C     IP     : N-vector IP(1:N); this vector contains pivoting   *
C              information that is needed by BANDS.              *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: BANDP, BANDS, MACHPD                    *
C                                                                *
C*****************************************************************
C                                                                *
C  author   : Elmar Pohl                                         *
C  date     : 01.16.1992                                         *
C  source   : FORTRAN 77                                         *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
      DIMENSION AP(LDAP,MB),B(N),IP(N)
C
      CALL BANDP(AP,LDAP,MB,N,ML,MU,IP,ISIG,IERR)
      IF(IERR .NE. 0) RETURN
      CALL BANDS(AP,LDAP,MB,N,ML,MU,B,IP)
      RETURN
      END
C
C

      SUBROUTINE BANDP(AP,LDAP,MB,N,ML,MU,IP,ISIG,IERR)
C
C*****************************************************************
C                                                                *
C     BANDP transforms a banded matrix AP to upper or lower      *
C     triangular form by applying a Gauss algorithm with         *
C     partial pivot search.                                      *
C     The triangular matrix and the                              *
C     transformation matrix are overwritten onto the original    *
C     array. If IERR=0, the subroutine BANDS may be applied in   *
C     order to solve several linear systems of equations.        *
C                                                                *
C                                                                *
C     INPUT PARAMETERS:                                          *
C     =================                                          *
C     AP     : 2-dimensional array AP(1:LDAP,1:MB); the band     *
C              matrix in condensed form. The rows of this array  *
C              contain the rows of the matrix AP, shifted to the *
C              left. The diagonals of AP, however, appear as     *
C              columns of AP:                                    *
C                    A(I,K) = AP(I,ML+1+K-I)                     *
C              where A denotes the matrix in uncondensed form.   *
C     LDAP   : leading dimension of AP as defined in the calling *
C              program                                           *
C     MB     : column dimension of AP. May differ from that used *
C              in the calling program; however, it must be at    *
C              least M + MIN(ML,MU) + 1, where M = MU+ML+1 is    *
C              the band width of AP.                             *
C     N      : order of the matrix AP                            *
C     ML     : number of lower co-diagonals                      *
C     MU     : number of upper co-diagonals                      *
C                                                                *
C                                                                *
C     OUTPUT PARAMETERS:                                         *
C     ==================                                         *
C     AP     : as above; triangular matrix and transforming      *
C              matrix                                            *
C     IP     : N-vector IP(1:N); pivoting information which is   *
C              needed for BANDS                                  *
C     ISIG   : = (-1)**IZ, where IZ denotes the number of row    *
C              permutations; to be used for calculating the      *
C              determinant:                                      *
C                                    N                           *
C                 DET(A) = ISIG * PRODUCT AP(I,ML+1)             *
C                                   I=1                          *
C                                                                *
C     IERR   : error parameter;                                  *
C                 IERR = 0 : no error                            *
C                 IERR.GT.0: in the IERR-th step, the pivot      *
C                            element becomes zero, the matrix AP *
C                            is numerically singular             *
C                 IERR.LT.0: row IERR contains only zeros,       *
C                            matrix is singular                  *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: MACHPD                                  *
C                                                                *
C*****************************************************************
C                                                                *
C  author   : Elmar Pohl                                         *
C  date     : 01.16.1992                                         *
C  source   : FORTRAN 77                                         *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
      DIMENSION AP(LDAP,MB),IP(N)
      LOGICAL UT
      M1 = ML + 1
      M = MU + M1
      MMB = M + MIN0(ML,MU)
C
C     calculate the machine constant
C
      FMACHP = 1.0D0
   80 FMACHP = 0.5D0 * FMACHP
      IF (MACHPD(1.0D0 + FMACHP) .EQ. 1) GOTO 80
      FMACHP = FMACHP * 2.0D0
C
C     determinaing the relative error bound
      EPS = 4.0D0 * FMACHP
C
C     Due to the pivot search the band width may increase. When
C     transforming to upper triangular form, ML additional
C     upper co-diagonals will appear, while transforming
C     to lower triangular form creates MU additional lower
C     co-diagonals. The program automatically selects the
C     most advantageous triangularization.
C
      UT = ML .LT. MU
C
C     UT = .TRUE.   : transforming to upper triangular form
C     UT = .FALSE.  : transforming to lower triangular form
C
C     the additional co-diagonals are stored in the (M+1)th
C     to MMB-th column of AP. At first they are initialized
C     to zero.
C     Simultaneously we compute and store the summed absolute
C     values of each row in the MMB + 1st column. (To be used
C     for checking nonsingularity)
C
      DO 10 I=1,N
         S = 0.0D0
         DO 90 K=MAX0(1,I-ML),MIN0(N,I+MU)
            S = S + DABS(AP(I,M1+K-I))
   90    CONTINUE
         IF (S .EQ. 0.0D0) THEN
            IERR = -I
            RETURN
         ENDIF
         AP(I,MMB+1) = S
         DO 20 K=M+1,MMB
            AP(I,K) = 0.0D0
   20    CONTINUE
   10 CONTINUE
C
      ISIG = 1
      IERR = 0
C
C     the index bounds and the direction of the sweep in the
C     following loops are set depending on UT in such a manner
C     that an upper or a lower triangular form is obtained.
C
      IF (UT) THEN
         IBEG = 1
         IEND = N-1
         ISTEP = 1
         KBEG = 1
         JBEG = 1
      ELSE
         IBEG = N
         IEND = 2
         ISTEP = -1
         KBEG = -1
         JBEG = -1
      ENDIF
C
C     loop over all rows
C
      DO 30 I=IBEG,IEND,ISTEP
         IF (UT) THEN
            KEND = MIN0(ML,N-I)
         ELSE
            KEND = MAX0(1-I,-MU)
         ENDIF
C
C        pivot search: searching for the element of largest
C        magnitude in the I-th column; store its index
C        (relative to I) in IV.
C
         IV = 0
         AM = DABS(AP(I,M1))
         DO 40 K=KBEG,KEND,ISTEP
            IF (DABS(AP(K+I,M1-K)) .GT. AM) THEN
               AM = DABS(AP(K+I,M1-K))
               IV = K
            ENDIF
   40    CONTINUE
         IF (AM/AP(I+IV,MMB+1) .LE. EPS) THEN
C
C           element of largest magnitude of the
C           column is zero, thus the matrix is singular
C
            IERR = I
            RETURN
         ENDIF
         IP(I) = IV
         IF (UT) THEN
            KJEND = MIN0(IV+MU,N-I)
         ELSE
            KJEND = MAX0(1-I,IV-ML)
         ENDIF
         IF (IV .NE. 0) THEN
C
C           interchange row I with row I+IV
C
            ISIG = -ISIG
            DO 50 K=0,KJEND,ISTEP
               KM = K+M1
               IF (KM .LE. 0) KM = KM+MMB
               H = AP(I,KM)
               AP(I,KM) = AP(I+IV,K+M1-IV)
               AP(I+IV,K+M1-IV) = H
   50       CONTINUE
            H = AP(I,MMB+1)
            AP(I,MMB+1) = AP(I+IV,MMB+1)
            AP(I+IV,MMB+1) = H
         ENDIF
C
C        elimination;
C        loop including all rows below row I:
C
         DO 60 K=KBEG,KEND,ISTEP
            AP(K+I,M1-K) = AP(K+I,M1-K) / AP(I,M1)
C
C           loop including all columns to the right of column I
C
            DO 70 J=JBEG,KJEND,ISTEP
               JK = J+M1-K
               JM = J+M1
C
C              With our condensing scheme, additional upper
C              co-diagonals would have to be stored to the right
C              of the M-th column and additional lower ones to the
C              left of the first column.
C              The latter would mean that we would need access to
C              storage space in front of AP(1,1).
C              In order to prevent this, MMB is added to all
C              column subscripts < 1. Thus additional lower
C              co-diagonals are also stored to the right of AP.
C
               IF (JK .LE. 0) JK = JK+MMB
               IF (JM .LE. 0) JM = JM+MMB
               AP(K+I,JK) = AP(K+I,JK)-AP(K+I,M1-K)*AP(I,JM)
   70       CONTINUE
   60    CONTINUE
   30 CONTINUE
      IP(IEND+ISTEP) = 0
      RETURN
      END
C
C

      SUBROUTINE BANDS(AP,LDAP,MB,N,ML,MU,B,IP)
C
C*****************************************************************
C                                                                *
C     After calling BANDP, the subroutine BANDS solves the linear*
C     system of equations consisting of a banded, condensed      *
C     coefficient matrix AP and a right hand side B.             *
C                                                                *
C                                                                *
C     INPUT PARAMETERS:                                          *
C     =================                                          *
C     AP     : 2-dimensional array AP(1:LDAP,1:MB); the trans-   *
C              formed coefficient matrix as put out by BANDP     *
C     LDAP   : leading dimension of AP as defined in the calling *
C              program                                           *
C     MB     : column dimension of AP which must be at least     *
C                         M + MIN(ML,MU) + 1                     *
C     N      : order of the matrix                               *
C     ML     : number of lower co-diagonals                      *
C     MU     : number of upper co-diagonals                      *
C     B      : N-vector B(1:N); the right hand side              *
C     IP     : N-vector IP(1:N); vector containing pivot infor-  *
C              mation. Should be used unchanged from BANDP.      *
C                                                                *
C                                                                *
C     OUTPUT PARAMETER:                                          *
C     =================                                          *
C     B            as above;  the solution                       *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Subroutines required: none                                    *
C                                                                *
C*****************************************************************
C                                                                *
C  author   : Elmar Pohl                                         *
C  date     : 01.16.1992                                         *
C  source   : FORTRAN 77                                         *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
      DIMENSION AP(LDAP,MB),IP(N),B(N)
      LOGICAL UT
C
      M1 = ML+1
      M = MU+M1
      MMB = M+MIN0(ML,MU)
      UT = ML .LT. MU
      IF (UT) THEN
         IBEG = 1
         IEND = N-1
         ISTEP = 1
         KBEG = 1
      ELSE
         IBEG = N
         IEND = 2
         ISTEP = -1
         KBEG = -1
      ENDIF
      DO 10 I=IBEG,IEND,ISTEP
         IF (IP(I) .NE. 0) THEN
            H = B(I)
            B(I) = B(I+IP(I))
            B(I+IP(I)) = H
         ENDIF
         IF (UT) THEN
            KEND = MIN0(ML,N-I)
         ELSE
            KEND = MAX0(1-I,-MU)
         ENDIF
         DO 20 K=KBEG,KEND,ISTEP
            B(K+I) = B(K+I)-AP(K+I,M1-K)*B(I)
   20    CONTINUE
   10 CONTINUE
      B(IEND+ISTEP) = B(IEND+ISTEP) / AP(IEND+ISTEP,M1)
      DO 30 I=IEND,IBEG,-ISTEP
         IF (UT) THEN
            KEND = MIN0(N-I,MU+ML)
         ELSE
            KEND = MAX0(1-I,-MU-ML)
         ENDIF
         DO 40 K=KBEG,KEND,ISTEP
            KM = K+M1
            IF (KM .LE. 0) KM = KM+MMB
            B(I) = B(I)-AP(I,KM)*B(K+I)
   40    CONTINUE
         B(I) = B(I)/AP(I,M1)
   30 CONTINUE
      RETURN
      END


Begin of file
Contents
Index