End of file
Contents
Index



F 4.17 The Algorithm of Cuthill-McKee for Sparse Symmetric Matrices


      SUBROUTINE CUTCHO (FMAT, FRS, FSOL, MAXELM, MAXROW, MAXAP,
     +                   M, IFLAG, V, IC, IR, NEIGHB, INB, LEVEL,
     +                   ILV, IDEG, ICM, ICMREV, MARK, RSORG, RS,
     +                   X, AP, Z)
C
C*****************************************************************
C                                                                *
C  CUTCHO solves a linear system with a sparse and symmetric     *
C  positive definite system matrix using the Cuthill-McKee       *
C  algorithm and the Cholesky decomposition.                     *
C                                                                *
C  The nonzero elements of the system matrix are  read in        *
C  from the data file FMAT. The Cuthill-McKee method then trans- *
C  forms the matrix to one with band structure of minimal band   *
C  width.                                                        *
C  The upper half band of this symmetric matrix is then condensed*
C  and the resulting matrix is factored using a Cholesky method  *
C  for condensed symmetric band matrices (SUBROUTINE CHOBDZ).    *
C  After CHOBDZ, the right hand sides are read from the data set *
C  FRS and solution vectors are found using CHOBDL. The solutions*
C  are stored in the data set FSOL.                              *
C                                                                *
C  If the given system matrix is not positive definite, its      *
C  Cholesky decomposition will be obtainable and thus the        *
C  SUBROUTINE CUTCHO cannot be used. In this case we recommend   *
C  using CUTGAU which used a version of the Gauß algorithm for   *
C  condensed matrices with partial pivoting that, however, uses  *
C  more operations and three times the storage of CUTCHO.        *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  FMAT   : CHAR*(*): Name of the input file of the nonzero      *
C           matrix elements                                      *
C           This data file is structured as follows:             *
C           - number of rows of the matrix                       *
C           - row wise:                                          *
C             - for every nonzero entry we store the tupel of    *
C               <column index> <entry>                           *
C               (indices start with 1)                           *
C             - a tupel with column index 0 designates the end of*
C               the row data                                     *
C  FRS    : CHAR*(*): Name of the input file for the right hand  *
C           sides in the form:                                   *
C           - number of right hand sides                         *
C           - for each right hand side:                          *
C             the entries appear in consecutive rows             *
C  FSOL   : CHAR*(*): Name of the output file for the solutions. *
C           It has the form:                                     *
C           - number of solutions (= number of right hand sides) *
C           - for each solution:                                 *
C             the entries appear in consecutive rows.            *
C  MAXELM : Dimensioning number for arrays, that will contain    *
C           matrix elements. MAXELM must be at least equal to the*
C           number of nonzero matrix elements.                   *
C  MAXROW : Dimensioning number for auxiliary arrays.            *
C           MAXROW must be at least as large as the number of    *
C           matrix rows.                                         *
C  MAXAP  : Upper index bound of vector AP                       *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  M      : Number of upper or lower nonzero codiagonals of the  *
C           condensed matrix                                     *
C  IFLAG  : error parameter:                                     *
C               1: no error                                      *
C           .NE.1: the matrix is numerically singular or not     *
C                  positive definite                             *
C                                                                *
C                                                                *
C  AUXILIARY PARAMETERS:                                         *
C  =====================                                         *
C  V      : vector V(1:MAXELM), Matrix in a linear list          *
C  IC     : vector IC(1:MAXELM), column indices of elements in V *
C  IR     : vector IR(1:MAXROW), starting indices of the rows of *
C           V                                                    *
C  NEIGHB : vector NEIGHB(1:MAXELM), incidence graph in a linear *
C           list                                                 *
C  INB    : vector INB(1:MAXROW), pointer for sublists in NEIGHB *
C  LEVEL  : vector LEVEL(1:MAXROW), level structure of a graph   *
C  ILV    : vector ILV(1:MAXROW), pointer for the levels in LEVEL*
C  IDEG   : vector IDEG(1:MAXROW), order of the nodes in the     *
C           graph                                                *
C  ICM    : vector ICM(1:MAXROW), Cuthill-McKee numbering        *
C  ICMREV : vector ICMREV(1:MAXROW), inverse permutation of ICM  *
C  MARK   : LOGICAL MARK(1:MAXROW), marks nodes                  *
C  RSORG  : vector RSORG(1:MAXROW), one right hand side          *
C  RS     : vector RS(1:MAXROW), RSORG after the Cuthill-McKee   *
C           permutation                                          *
C  X      : vector X(1:MAXROW), the solution still to be permuted*
C  AP     : vector AP(1:MAXROW*(M+1)), upper band of the         *
C           transformed matrix in condensed form.                *
C           M is the number of upper codiagonals of the condensed*
C           matrix. This number is found when performing the     *
C           Cuthill-McKee numbering scheme, hence M is not known *
C           before the program is run. Estimates exist in the    *
C           literature.                                          *
C  Z      : auxiliary vector IP(1:MAXROW) used in CHOBDZ         *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Required subroutines:                                         *
C                                                                *
C  RDMTRX  reads matrix from input file into arrays              *
C  BLDGPH  constructs the incidence graph of the matrix          *
C  CUTHIL  computes the Cuthill-McKee permutation                *
C  CUTH1K  Cuthill-McKee numbering for one component of the graph*
C  FNDROO  searches for starting nodes for the optimal level     *
C          structure                                             *
C  LVSTRU  constructs level structure of one component of the    *
C          graph                                                 *
C  SRTDEG  sorts nodes by their level                            *
C  IBDWID  computes half the band width of the condensed matrix  *
C  CUTPAK  forms condensed band matrix for SUBROUTINE CHOBDZ     *
C  PERMUT  permutes the elements of a vector                     *
C  CHOBDZ  decomposes a condensed band matrix using Cholesky     *
C  CHOBDL  solves a linear system given in CHOBDZ factorization  *
C                                                                *
C*****************************************************************
C                                                                *
C  Author    : Elmar Pohl                                        *
C  Date      : 11.17.1991                                        *
C  Source    : FORTRAN 77                                        *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
      INTEGER IC(MAXELM), IR(MAXROW), NEIGHB(MAXELM), INB(MAXROW)
      INTEGER LEVEL(MAXROW), ILV(MAXROW)
      INTEGER IDEG(MAXROW), ICM(MAXROW), ICMREV(MAXROW)
      LOGICAL MARK(MAXROW)
      DIMENSION V(MAXELM), RSORG(MAXROW), RS(MAXROW)
      DIMENSION X(MAXROW), Z(MAXROW), AP(*)
      CHARACTER*(*) FMAT, FRS, FSOL
C
      PARAMETER (IFRS=8, IFSOL=9)
C
      NROW = 0
      NV = 0
      NLV = 0
C
C     Read in matrix
C
      CALL RDMTRX (FMAT, MAXELM, MAXROW, NROW, NV, V, IC, IR)
C
C     Construct the incidence gragh of the matrix
C
      CALL BLDGPH (NROW, IC, IR, NEIGHB, INB, IDEG)
C
C     Find the CUTHILL-MCKEE permutation
C
      CALL CUTHIL (NROW, NEIGHB, INB, IDEG, ICM,
     +             ICMREV, MARK, LEVEL, ILV)
C
C     Find half the bandwidth of the transformed matrix
C
      M = IBDWID (NROW, NEIGHB, INB, ICM, ICMREV)
      if (nrow * m .gt. maxap) then
        write (*,*) 'CUTCHO: AP too small for condensed matrix!'
        stop
      end if
C
C     prevent the new permutation from increasing the band width
C
      call ckbdwd(nrow, neighb, inb, m, icm, icmrev)
C
C     Condense the matrix for Cholesky
C
      CALL CUTPAK (NROW, M, V, IR, IC, ICMREV, AP)
C
C     Cholesky decomposition
C
      CALL CHOBDZ (NROW, M, AP, JFLAG, Z)
      IFLAG = JFLAG
      IF (IFLAG .NE. 1) RETURN
C
C     open the data file FRS, prepare to read in right hand sides
C
      OPEN (UNIT=IFRS, FILE=FRS)
      READ (IFRS, *) NRS
C
C     open the data set FSOL for the solution vectors
C
      OPEN (UNIT=IFSOL, FILE=FSOL)
      WRITE (IFSOL, '(1X,I5)') NRS
C
C     Loop for all right hand sides
C
      DO 10 IRS = 1, NRS
C
C        Read in the  IRS-th right hand side
C
         READ (IFRS,*) (RSORG(I), I=1,NROW)
C
C        Permute right hand side according to Cuthill-McKee permutaion
C
         CALL PERMUT (NROW, ICMREV, RSORG, RS)
C
C        Solve linear system
C
         CALL CHOBDL (NROW, M, AP, RS, X, Z)
C
C        Write solution onto output data file
C
         DO 30 I = 1, NROW
            WRITE (IFSOL, '(1X,D17.10)') X(ICMREV(I))
   30    CONTINUE
   10 CONTINUE
C
      CLOSE (IFRS)
      CLOSE (IFSOL)
C
      RETURN
      END
C
C

      SUBROUTINE CUTHIL (NNODES, NEIGHB, INB, IDEG,
     +                   ICM, ICMREV, MARK, LEVEL, ILV)
C
C*****************************************************************
C                                                                *
C  CUTHIL computes the Cuthill-McKee numbering of a graph.       *
C  This Cuthill-McKee numbering is used to solve linear syatems  *
C  with sparse and symmetric system matrices and saves storage   *
C  space and computation al time. When using the Cuthill-McKee   *
C  permutation on the graph of a symmetric matrix, the matrix is *
C  transformed into a symmetric band matrix with a generally     *
C  reduced bandwidth.                                            *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  NNODES : number of nodes of the graph. The graph is determined*
C           by the following two vectors:                        *
C  NEIGHB : vector NEIGHB(1:*), the list of adjacent nodes.      *
C           For I=1, ..., NNODES, the vector NEIGHB contains the *
C           numbers of adjacent nodes of node I in positions     *
C           NEIGHB(K) where K=INB(I), ..., INB(I+1)-1.           *
C  INB    : vector INB(1:NNODES+1) containing the indices for    *
C           NEIGHB.                                              *
C           INB(NNODES+1) must be equal to the number of entries *
C           in NEIGHB plus 1.                                    *
C  IDEG   : vector IDEG(1:NNODES), containing the degree of every*
C           node, i.e., the number of its neighbors.             *
C                                                                *
C  The vectors  NEIGHB, INB and IDEG can be formed from A by     *
C  using SUBROUTINE BLDGPH.                                      *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  ICM    : vector ICM(1:NNODES) containing the permutations of  *
C           the nodes according to Cuthill-McKee. For I=1, ...,  *
C           NNODES,  ICM(I)  describes the original index of the *
C           node, while I is its Cuthill-McKee number            *
C  ICMREV : vector ICMREV(1:NNODES), the inverse permutation of  *
C           ICM: For I=1(1)NNODES, ICMREV(I) denotes the Cuthill-*
C           McKee number of the node originally numbered I.      *
C                                                                *
C  REMARK:                                                       *
C        One of the permutation vectors ICM or ICMREV is clearly *
C        redundant. One can form the transformed matrix          *
C        completely from ICM. However, if one wants to condense  *
C        the transformed matrix, one would have to conduct       *
C        expensive searches inside ICM, unless one has its       *
C        inverse ICMREV available.                               *
C                                                                *
C                                                                *
C  AUXILIARY VECTORS:                                            *
C  ==================                                            *
C  MARK   : LOGICAL MARK(1:NNODES) for labelling nodes           *
C  LEVEL  : vector LEVEL(1:NNODES) for denoting the level        *
C           structure of one component of the graph              *
C  ILV    : vector ILV(1:NNODES) containing the starting indices *
C           of levels in the vector LEVEL                        *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Required subroutines:                                         *
C                                                                *
C  FNDROO   searches for starting nodes for an optimal level     *
C           structure                                            *
C  CUTH1K   Cuthill-McKee numbering of one component of the graph*
C  LVSTRU   constructs the level structure of graph component    *
C  SRTDEG   sorts nodes according to degree                      *
C                                                                *
C*****************************************************************
C                                                                *
C  Author    : Elmar Pohl                                        *
C  Date      : 11.17.1991                                        *
C  Source    : FORTRAN 77                                        *
C                                                                *
C*****************************************************************
C
      INTEGER NEIGHB(*), INB(1:NNODES+1), IDEG(1:NNODES)
      INTEGER ICM(1:NNODES), ICMREV(1:NNODES)
      INTEGER LEVEL(1:NNODES), ILV(1:NNODES)
      LOGICAL MARK(1:NNODES)
\hbox{\JDhspace\verb`
      DO 10 I = 1, NNODES
         MARK(I) = .FALSE.
         ICM(I) = 0
   10 CONTINUE
      NFOUND = 0
      DO 20 I = 1, NNODES
         IF (.NOT. MARK(I)) THEN
C
C           Start of a new component in the graph
C
            IROOT = I
C
C           Search a starting node that will give a level structure of
C           maximal length
C
            CALL FNDROO (IROOT, NNODES, NEIGHB,
     +                   INB, IDEG, MARK, NLV, LEVEL, ILV, LNODES)
C
C           Cuthill-McKee numbering of this component
C
            CALL CUTH1K (IROOT, NFOUND + 1, NNODES,
     +                   NEIGHB, INB, IDEG, MARK, ICM)
            NFOUND = NFOUND + LNODES
         END IF
   20 CONTINUE
C
C     All components of the graph have been numbered.
C     Form the inverse ICMREV of ICM
C
      DO 30 I = 1, NNODES
         ICMREV(ICM(I)) = I
   30 CONTINUE
      RETURN
      END
C
C

      SUBROUTINE CUTH1K (IROOT, ISTART, NNODES,
     +                   NEIGHB, INB, IDEG, MARK, ICM)
C
C*****************************************************************
C                                                                *
C  Subroutine for the Cuthill-McKee algorithm.                   *
C  It determines the component induced by the node IROOT together*
C  with its  Cuthill-McKee numbering.                            *
C                                                                *
C  In order to find the Cuthill-McKee numbering of a graph, one  *
C  calls CUTHIL and not CUTH1K. CUTHIL in turn calls CUTH1K      *
C  repeatedly until all components of the graph have been found. *
C  Hence  CUTHIL will work equally well for disconnected graphs. *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  IROOT  : Number of the starting node                          *
C           (output of SUBROUTINE FNDROO())                      *
C  ISTART : Starting index for the Cuthill-McKee numbering of the*
C           new component                                        *
C  NNODES : Number of nodes of the graph. The graph is stored in *
C           the two vectors below:                               *
C  NEIGHB : vector NEIGHB(1:*), the list of adjacent nodes.      *
C           For I=1, ..., NNODES, the vector NEIGHB contains the *
C           numbers of adjacent nodes of node I in positions     *
C           NEIGHB(K) where K=INB(I), ..., INB(I+1)-1.           *
C  INB    : vector INB(1:NNODES+1) containing the indices for    *
C           NEIGHB.                                              *
C           INB(NNODES+1) must be equal to the number of entries *
C           in NEIGHB plus 1.                                    *
C  IDEG   : vector IDEG(1:NNODES), containing the degree of every*
C           node, i.e., the number of its neighbors.             *
C  MARK   : LOGICAL MARK(1:NNODES), node markers.                *
C           If MARK(I)=.FALSE., then the node labelled I can be  *
C           used in the new component. Otherwise it belongs to   *
C           another componentn from an earlier call of CUTH1K.   *
C                                                                *
C  The vectors  NEIGHB, INB and IDEG can be formed by using      *
C  SUBROUTINE BLDGPH.                                            *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  ICM    : vector ICM(1:NNODES) containing the permutations of  *
C           the nodes according to Cuthill-McKee. For I=1, ...,  *
C           NNODES,  ICM(I)  describes the original index of the *
C           node, while I is its Cuthill-McKee number            *
C           The entries for I=ISTART, ..., ISTART+NNEW-1  are    *
C           adjusted when calling CUTH1K, where NNEW denotes the *
C           number of nodes of the new component.                *
C  MARK   : same as on input, except that the indices of nodes in*
C           the new component are now labelled .TRUE. .          *
C                                                                *
C  By successively calling  CUTH1K  for increasing values of     *
C  ISTART, all positions in ICM and MARK are set.                *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Required subroutines:                                         *
C                                                                *
C  SRTDEG   sorts nodes according to degree                      *
C                                                                *
C*****************************************************************
C                                                                *
C  Author    : Elmar Pohl                                        *
C  Date      : 11.17.1991                                        *
C  Source    : FORTRAN 77                                        *
C                                                                *
C*****************************************************************
C
      INTEGER NEIGHB(*), INB(1:NNODES+1), IDEG(1:NNODES)
      INTEGER ICM(1:NNODES)
      LOGICAL MARK(1:NNODES)
C
C     The method is similar to the algorithm for finding the
C     level structure. This level structure is formed in the
C     vector ICM. In addition we also make lists of nodes
C     (ordered by degree) that are appended to existing level sets.
C
      ICM(ISTART) = IROOT
      MARK(IROOT) = .TRUE.
\hbox{\JDhspace\verb`
      NEWEND = ISTART
C
C     NEWEND denotes the final node of a component
C     while it is being formed
C
      LEVEND = ISTART - 1
   10 CONTINUE
         LEVBEG = LEVEND + 1
         LEVEND = NEWEND
C
C        LEVBEG denotes the start of the last level in ICM(),
C        LEVEND marks the end.
C
C        Find nodes of the next level:
C        search for nodes adjacent to lower level nodes
C        and enter them in ICM in case they have not been
C        marked .TRUE. before.
C
         DO 20 I = LEVBEG, LEVEND
C
C           Find a list of unmarked neighbors of the
C           node originally labelled by ICM(I).
C
            NEWBEG = NEWEND + 1
C
C           ICM is the starting index of this list
C
            DO 30 J = INB(ICM(I)), INB(ICM(I) + 1) - 1
               IF (.NOT. MARK(NEIGHB(J))) THEN
                  NEWEND = NEWEND + 1
                  ICM(NEWEND) = NEIGHB(J)
                  MARK(NEIGHB(J)) = .TRUE.
               END IF
   30       CONTINUE
C
C           Sort ICM(NEWBEG), ..., ICM(NEWEND) by increasing degree
C
            CALL SRTDEG (ICM, IDEG, NEWBEG, NEWEND)
   20    CONTINUE
C
C     Stay inside this loop as long as new nodes are being found.
C
      IF (NEWEND .GT. LEVEND) GOTO 10
      RETURN
      END
C
C

      SUBROUTINE BLDGPH (NROW, IC, IR, NEIGHB, INB, IDEG)
C
C*****************************************************************
C                                                                *
C  Subroutine for the Cuthill-McKee method.                      *
C  Form the graph of a symmetric matrix.                         *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  NROW   : number of rows                                       *
C  IC     : vector IC(1:NV) with the column indices of the       *
C           nonzero matrix entries                               *
C           (NV = number of nonzero matrix entries)              *
C  IR     : vector IR(1:NROW+1) with the indices for the         *
C           beginnings of rows. IR(NROW+1) must equal NV+1.      *
C                                                                *
C  All inputs are available as outputs of SUBROUTINE RDMTRX.     *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  NEIGHB : vector NEIGB(1:NV-NROW) with the indices of adjacent *
C           nodes.                                               *
C           Each row I corresponds to node I. If I.NE.K, then    *
C           node I is adjacent to node K provided A(I,K).NE.0.   *
C           Since the system matrix is assumed symmetric, if I   *
C           is adjacent to K, so is K to I.                      *
C           For I=1, ..., NROW, the vector NEIGHB contains the   *
C           indices of adjacent nodes for node I from index      *
C           INB(I) to index  INB(I+1)-1).                        *
C  INB    : vector INB(1:NROW+1) with indices for the vector     *
C           NEIGHB.                                              *
C           For I=1, ..., NROW, INB(I) denotes the starting      *
C           index of the list of adjacent nodes for I in NEIGHB. *
C           This list extends to index INB(I+1)-1. We always have*
C           INB(NROW+1) = NV-NROW+1.                             *
C  IDEG   : vector IDEG(1:NROW) which specifies the degree of    *
C           each node I=1, ..., NROW, i.e., the number of nodes  *
C           adjacent to node I.                                  *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Required subroutines: none                                    *
C                                                                *
C*****************************************************************
C                                                                *
C  Author    : Elmar Pohl                                        *
C  Date      : 11.17.1991                                        *
C  Source    : FORTRAN 77                                        *
C                                                                *
C*****************************************************************
C
      INTEGER IC(*), IR(1:NROW+1), NEIGHB(*)
      INTEGER INB(1:NROW+1), IDEG(1:NROW)
C
      N = 0
      DO 10 I = 1, NROW
         INB(I) = N + 1
         DO 20 K = IR(I), IR(I + 1) - 1
               IF (IC(K) .NE. I) THEN
                  N = N + 1
                  NEIGHB(N) = IC(K)
               END IF
   20    CONTINUE
         IDEG(I) = N + 1 - INB(I)
   10 CONTINUE
      INB(NROW + 1) = N + 1
      RETURN
      END
C
C

      SUBROUTINE CUTPAK (N, M, V, IR, IC, ICMREV, AP)
C
C*****************************************************************
C                                                                *
C  Subroutine for solving a linear system via  Cuthill-McKee     *
C  and Cholesky.                                                 *
C  CUTPAK performs the Cuthill-McKee permutation specified in ICM*
C  for the matrix that is given in  V, IR and IC and condenses   *
C  the upper band of the resulting symmetric matrix in the array *
C  AP.                                                           *
C  This array AP can subsequently be used to solve linear systems*
C  using the  SUBROUTINE CHOBND/CHOBDZ/CHOBDL.                   *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  N      : number of rows of the matrix                         *
C  M      : number of upper codiagonals after  Cuthill-McKee     *
C           permutation                                          *
C  V      : vector V(1:*), which contains the nonzero elements of*
C           the matrix row after row                             *
C  IC     : vector IC(1:*) of column indices for each entry in V *
C  IR     : vector IR(1:N+1), containing the starting index for  *
C           each row in V or IC. We must have                    *
C               IR(N+1) =  1 + number of entries in V .          *
C  ICMREV : vector ICMREV(1:N), the inverse permutation of the   *
C           Cuthill-McKee numbering ICM. For I=1, ..., N,        *
C           ICMREV(I) denotes the Cuthill-McKee number of the    *
C           node with the original index I.                      *
C                                                                *
C  N,V,IR and IC are outputs of SUBROUTINE RDMTRX.               *
C  M is an output of FUNCTION IBDWID.                            *
C  ICMREV is an output of SUBROUTINE CUTHIL.                     *
C                                                                *
C                                                                *
C  OUTPUT PARAMETER:                                             *
C  =================                                             *
C  AP     : array AP(1:N,1:M+1), the condensed matrix            *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Required subroutines: none                                    *
C                                                                *
C*****************************************************************
C                                                                *
C  Author    : Elmar Pohl                                        *
C  Date      : 11.17.1991                                        *
C  Source    : FORTRAN 77                                        *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
      DIMENSION V(*), AP(1:N,*)
      INTEGER IC(*), IR(*), ICMREV(*)
C
      DO 10 I = 1, N
         DO 20 K = 1, M + 1
            AP(I, K) = 0.0D0
   20    CONTINUE
   10 CONTINUE
C
      DO 30 I = 1, N
         IREV = ICMREV(I)
         DO 40 K = IR(I), IR(I + 1) - 1
            KREV = ICMREV(IC(K))
            IF (KREV .GE. IREV)  AP(IREV, KREV - IREV + 1) = V(K)
   40    CONTINUE
   30 CONTINUE
      RETURN
      END
C
C

      SUBROUTINE CUTPK2 (N, M, V, IR, IC, ICMREV, AP)
C
C*****************************************************************
C                                                                *
C  Subroutine for solving a linear system via  Cuthill-McKee     *
C  and Gauß.                                                     *
C  CUTPK2 performs the Cuthill-McKee permutation specified in ICM*
C  for the matrix that is given in  V, IR and IC and condenses   *
C  the upper band of the resulting symmetric matrix in the array *
C  AP.                                                           *
C  This array AP can subsequently be used to solve linear systems*
C  using the  SUBROUTINE BAND/BANDP/BANDS.                       *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  N      : number of rows of the matrix                         *
C  M      : number of upper codiagonals after  Cuthill-McKee     *
C           permutation                                          *
C  V      : vector V(1:*), which contains the nonzero elements of*
C           the matrix row after row                             *
C  IC     : vector IC(1:*) of column indices for each entry in V *
C  IR     : vector IR(1:N+1), containing the starting index for  *
C           each row in V or IC. We must have                    *
C               IR(N+1) =  1 + number of entries in V .          *
C  ICMREV : vector ICMREV(1:N), the inverse permutation of the   *
C           Cuthill-McKee numbering ICM. For I=1, ..., N,        *
C           ICMREV(I) denotes the Cuthill-McKee number of the    *
C           node with the original index I.                      *
C                                                                *
C  N,V,IR and IC are outputs of SUBROUTINE RDMTRX.               *
C  M is an output of FUNCTION IBDWID.                            *
C  ICMREV is an output of SUBROUTINE CUTHIL.                     *
C                                                                *
C                                                                *
C  OUTPUT PARAMETER:                                             *
C  =================                                             *
C  AP     : array AP(1:N,1:M+1), the condensed matrix            *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Required subroutines: none                                    *
C                                                                *
C*****************************************************************
C                                                                *
C  Author    : Elmar Pohl                                        *
C  Date      : 11.17.1991                                        *
C  Source    : FORTRAN 77                                        *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
      DIMENSION V(*), AP(1:N,*)
      INTEGER IC(*), IR(*), ICMREV(*)
C
      DO 10 I = 1, N
         DO 20 K = 1, 2*M + 1
            AP(I, K) = 0.0D0
   20    CONTINUE
   10 CONTINUE
C
      DO 30 I = 1, N
         IREV = ICMREV(I)
         DO 40 K = IR(I), IR(I + 1) - 1
            AP(IREV, M + 1 + ICMREV(IC(K)) - IREV) = V(K)
   40    CONTINUE
   30 CONTINUE
      RETURN
      END
C
C

      SUBROUTINE FNDROO (IROOT, NNODES, NEIGHB, INB,
     +                   IDEG, MARK, NLV, LEVEL, ILV, LNODES)
C
C*****************************************************************
C                                                                *
C  Subroutine for the Cuthill-McKee algorithm.                   *
C  It constructs the level structure of the component of the     *
C  graph of IROOT and attempts to choose a starting node so that *
C  the resulting structure will have as many levels as possible. *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  IROOT  : Number of the node that defines the component        *
C  NNODES : Number of nodes of the graph. The graph is defined by*
C           the following two vectors:                           *
C  NEIGHB : vector NEIGHB(1:*) with the lists of adjacent nodes  *
C           For I=1, ..., NNODES, the vector NEIGHB contains the *
C           indices of the nodes that are adjacent to node I in  *
C           NEIGHB(K) for  K=INB(I), ...,  INB(I+1)-1.           *
C  INB    : vector INB(1:NNODES+1) with indices for the sublists *
C           in NEIGHB. We must have that                         *
C             INB(NNODES+1) = 1 + number of elements in NEIGHB . *
C  IDEG   : vector IDEG(1:NNODES) of degrees of the nodes        *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  IROOT  : new starting node                                    *
C  NLV    : number of levels                                     *
C  LEVEL  : vector LEVEL(1:NNODES) listing nodes of identical    *
C           level. For I=1, ..., NLV, the vector LEVEL contains  *
C           the indices of the nodes of level I in positions     *
C           LEVEL(K) for  K = ILV(I), ..., ILV(I+1)-1.           *
C  ILV    : vector ILV(1:NLV+1) with indices for the level list  *
C           LEVEL(). We must have  ILV(NLV+1) = 1 + number of    *
C           entries in LEVEL .  If the graph is connected, this  *
C           number is equal to  NNODES + 1.                      *
C  LNODES : number of nodes in the component                     *
C                                                                *
C                                                                *
C  AUXILIARY PARAMETER:                                          *
C  ====================                                          *
C  MARK   : LOGICAL MARK(1:NNODES), marking some nodes           *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Required subroutines:                                         *
C                                                                *
C  LVSTRU    determines the level structure of one component of  *
C            the graph                                           *
C                                                                *
C*****************************************************************
C                                                                *
C  Author    : Elmar Pohl                                        *
C  Date      : 11.17.1991                                        *
C  Source    : FORTRAN 77                                        *
C                                                                *
C*****************************************************************
C
      INTEGER NEIGHB(*), INB(*), IDEG(*), LEVEL(*), ILV(*)
      LOGICAL MARK(*)
C
      NLVOLD = 0
   10 CONTINUE
         CALL LVSTRU (IROOT, NNODES, NEIGHB, INB,
     +                MARK, NLV, LEVEL, ILV, LNODES)
C
C        This is the exit from the loop
C
         IF (NLV .LE. NLVOLD) RETURN
C
         NLVOLD = NLV
C
C        Search for node of minimal degree in the previous level
C
         IMIN = ILV(NLV)
         IDGMIN = IDEG(LEVEL(IMIN))
         DO 20 I = ILV(NLV) + 1, ILV(NLV + 1) - 1
            IF (IDEG(LEVEL(I)) .LT. IDGMIN) THEN
               IMIN = I
               IDGMIN = IDEG(LEVEL(I))
            END IF
   20    CONTINUE
C
C        Use this node as a start to construct
C        the level structure
C
         IROOT = LEVEL(IMIN)
      GOTO 10
      RETURN
      END
C
C

      INTEGER FUNCTION IBDWID (NNODES, NEIGHB, INB, NOLD, NNEW)
C
C*****************************************************************
C                                                                *
C  Subroutine for the Cuthill-McKee algorithm.                   *
C  It determines the band width of a matrix with known           *
C  permutation of the nodes of its graph.                        *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  NNODES : )  same as output from SUBROUTINE BLDGPH.            *
C  NEIGHB : )  These vectors describe the graph of the matrix.   *
C  INB    : )                                                    *
C  NOLD   : permutation vector NOLD(1:NNODES)                    *
C           For I=1, ..., NNODES,  NORG(I) designates the        *
C           original index of the node now numbered by I.        *
C  NNEW   : vector NNEW(1:NNODES), the inverse permutation of    *
C           NOLD.                                                *
C           For I=1, ..., NNODES,  NNEW(I) indicates the new     *
C           index of the node previously numbered by I.          *
C                                                                *
C                                                                *
C  OUTPUT PARAMETER:                                             *
C  =================                                             *
C  IBDWID : Band width, i.e., the maximal distance of two        *
C           adjacent nodes after the permutation                 *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Required subroutines: none                                    *
C                                                                *
C*****************************************************************
C                                                                *
C  Author    : Elmar Pohl                                        *
C  Date      : 11.17.1991                                        *
C  Source    : FORTRAN 77                                        *
C                                                                *
C*****************************************************************
C
      INTEGER NEIGHB(*), INB(*), NNEW(*), NOLD(*)
C
      MAXBW = 0
      DO 10 I = 1, NNODES - 1
         DO 20 K = INB(NOLD(I)), INB(NOLD(I) + 1) - 1
            IDIFF = ABS(I - NNEW(NEIGHB(K)))
            IF (IDIFF .GT. MAXBW) MAXBW = IDIFF
   20    CONTINUE
   10 CONTINUE
      IBDWID = MAXBW
      RETURN
      END
C
C

      subroutine ckbdwd (n, neighb, inb, m, icm, icmrev)
C
C*****************************************************************
C check if by applying the Cuthill-McKee permutation the band    *
C width might be enlarged instead of being reduced. In this      *
C unlucky case the matrix shall remain unchanged, that is shall  *
C not be permuted.                                               *
C                                                                *
C Input parameters:                                              *
C =================                                              *
C N          order of the sparse matrix          \  incidence    *
C NEIGHB     indices of adjacent nodes            > graph        *
C INB        indices for NEIGHB                  /  (see BLDGPH) *
C M          half band width of the matrix produced by applying  *
C            the Cuthill-McKee permutation                       *
C ICM        (1:N)-vector with the CM-permutation. For i=1(1)n   *
C            ICM(i) is the original number of the node with the  *
C            new number i.                                       *
C ICMREV     (1:N)-vector with the inverse permutation of ICM.   *
C            For i=1(1)n ICMREV(i) is the new number of the node *
C            with the old number i.                              *
C                                                                *
C Output parameters:                                             *
C ==================                                             *
C M          unchanged, if M <= original band width, else the    *
C            original band width                                 *
C ICM        (1:N)-vector with the identical permutation, if M   *
C            had to be corrected, else with the CM-permutation   *
C ICMREV     (1:N)-vector with the inverse permutation of ICM    *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Required subroutines: none                                    *
C                                                                *
C*****************************************************************
C                                                                *
C  Author    : Juergen Dietel                                    *
C  Date      : 06.19.1996                                        *
C  Source    : FORTRAN 77                                        *
C                                                                *
C*****************************************************************
C
      integer n, neighb(*), inb(*), m, icm(*), icmrev(*)
C     half band width of the original matrix
      integer morig
      integer diff
      integer i
      integer j
C
C
      morig = 0
      do 20 i = 1, n
        do 10 j = inb(i), inb(i + 1) - 1
          diff = abs(i - neighb(j))
          if (diff .gt. morig) morig = diff
  10    continue
  20  continue
C
C     new band width not smaller, but really bigger???
C     In this unlucky case the matrix shall remain unchanged.
C
      if (m .gt. morig) then
        m = morig
        do 30 i = 1, n
          icm(i)    = i
          icmrev(i) = i
   30   continue
      end if
\hbox{\JDhspace\verb`
      end
C
C

      SUBROUTINE LVSTRU (IROOT, NNODES, NEIGHB, INB,
     +                   MARK, NLV, LEVEL, ILV, LNODES)
C
C*****************************************************************
C                                                                *
C  Subroutine for the Cuthill-McKee algorithm.                   *
C  It constructs the level structure of the component of a graph *
C  generated by IROOT.                                           *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  IROOT  : Number of the starting node                          *
C  NNODES : Number of nodes of the graph. The graph is defined by*
C           the following two vectors:                           *
C  NEIGHB : vector NEIGHB(1:*) with the lists of adjacent nodes  *
C           For I=1, ..., NNODES, the vector NEIGHB contains the *
C           indices of the nodes that are adjacent to node I in  *
C           NEIGHB(K) for  K=INB(I), ...,  INB(I+1)-1.           *
C  INB    : vector INB(1:NNODES+1) with indices for the sublists *
C           in NEIGHB. We must have that                         *
C             INB(NNODES+1) = 1 + number of elements in NEIGHB . *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  NLV    : number of levels                                     *
C  LEVEL  : vector LEVEL(1:NNODES) listing nodes of identical    *
C           level. For I=1, ..., NLV, the vector LEVEL contains  *
C           the indices of the nodes of level I in positions     *
C           LEVEL(K) for  K = ILV(I), ..., ILV(I+1)-1.           *
C  ILV    : vector ILV(1:NLV+1) with indices for the level list  *
C           LEVEL(). We must have  ILV(NLV+1) = 1 + number of    *
C           entries in LEVEL .  If the graph is connected, this  *
C           number is equal to  NNODES + 1.                      *
C  LNODES : number of nodes in the component                     *
C                                                                *
C                                                                *
C  AUXILIARY PARAMETER:                                          *
C  ====================                                          *
C  MARK   : LOGICAL MARK(1:NNODES), marking some nodes           *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Required subroutines: none                                    *
C                                                                *
C*****************************************************************
C                                                                *
C  Author    : Elmar Pohl                                        *
C  Date      : 11.17.1991                                        *
C  Source    : FORTRAN 77                                        *
C                                                                *
C*****************************************************************
C
      INTEGER NEIGHB(*), INB(1:NNODES+1), LEVEL(1:NNODES), ILV(*)
      LOGICAL MARK(1:NNODES)
C
      NLV = 0
      LEVEL(1) = IROOT
      MARK(IROOT) = .TRUE.
      N = 1
C
C     N is the number of nodes already found
C
      LEVEND = 0
   10 CONTINUE
         NLV = NLV + 1
C
C        NLV is the number of already found levels
C
         LEVBEG = LEVEND + 1
         LEVEND = N
C
C        LEVBEG denotes the start, while LEVEND denotes the end
C        of the last level in LEVEL()
C
         ILV(NLV) = LEVBEG
C
C        Find nodes of level  NLV+1:
C        search for nodes adjacent to nodes of level NLV,
C        record them in LEVEL, if they have not been marked
C
         DO 20 I = LEVBEG, LEVEND
            DO 30 J = INB(LEVEL(I)), INB(LEVEL(I) + 1) - 1
                IF (.NOT. MARK(NEIGHB(J))) THEN
                   N = N + 1
                   LEVEL(N) = NEIGHB(J)
                   MARK(NEIGHB(J)) = .TRUE.
                END IF
   30       CONTINUE
   20    CONTINUE
      IF (N .GT. LEVEND) GOTO 10
C
      LNODES = LEVEND
      ILV(NLV + 1) = LNODES + 1
C
C     Mark all recently marked nodes .FALSE.
C
      DO 40 I = 1, LNODES
         MARK(LEVEL(I)) = .FALSE.
   40 CONTINUE
      RETURN
      END
C
C

      SUBROUTINE PERMUT (N, IPERM, XOLD, XNEW)
C
C*****************************************************************
C                                                                *
C  Subroutine for solving linear systems of equations with the   *
C  Cuthill-McKee algorithm.                                      *
C  PERMUT performs the permutation defined in IPERM on XOLD.     *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  N      : order of the vector                                  *
C  IPERM  : vector IPERM(1:N) with the permutations of 1, ..., N *
C  XOLD   : vector XOLD(1:N) whose entries are to be permuted    *
C                                                                *
C                                                                *
C  OUTPUT PARAMETER:                                             *
C  =================                                             *
C  XNEW   : vector XNEW(1:N), the permuted vector                *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Required subroutines: none                                    *
C                                                                *
C*****************************************************************
C                                                                *
C  Author    : Elmar Pohl                                        *
C  Date      : 17.11.1991                                        *
C  Source    : FORTRAN 77                                        *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
      INTEGER IPERM(*)
      DIMENSION XOLD(*), XNEW(*)
C
      DO 10 I = 1, N
         XNEW(IPERM(I)) = XOLD(I)
   10 CONTINUE
      RETURN
      END
C
C

      SUBROUTINE RDMTRX (FLNAM, MAXELM, MAXROW, NROW, NV, V, IC,
     +                   IR)
C
C*****************************************************************
C                                                                *
C  Subroutine for solving of linear systems with sparse matrices.*
C  It opens a data file and reads matrix elements into the vector*
C  V. It thus prepares for the Cuthill-McKee algorithm.          *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  FLNAM  : Name of the input file with the following structure: *
C           - number of rows of the matrix                       *
C           - for each row:                                      *
C             - for each nonzero element we store the tupel:     *
C               <column index> <element>                         *
C               (indices start at 1)                             *
C             - a tupel with column index 0 denotes the end of   *
C               the row                                          *
C  MAXELM : Dimensioning number for arrays, that will contain    *
C           matrix elements. MAXELM must be at least equal to the*
C           number of nonzero matrix elements.                   *
C  MAXROW : Dimensioning number for auxiliary arrays.            *
C           MAXROW must be at least as large as the number of    *
C           matrix rows.                                         *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  NROW   : number of rows                                       *
C  NV     : number of entries in the vector V ( = number of non- *
C           zero entries in the original matrix). The vector IC  *
C           has the same number of entries.                      *
C  V      : vector V(1:NV) with nonzero entries. The nonzero     *
C           elements of the original matrix are written row-wise *
C           and in sequence in V.                                *
C  IC     : vector IC(1:NV) of column indices. For each V(I), the*
C           value in IC(I) denotes the column of the matrix that *
C           contained  V(I). (Indices start with 1)              *
C  IR     : vector IR(1:NROW+1) with row pointers. For I=1, ..., *
C           , NROW,  IR(I) denotes the index, where row  I starts*
C           in  V and IC. We must have  IR(NROW+1) =  NV+1.      *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Required subroutines: none                                    *
C                                                                *
C*****************************************************************
C                                                                *
C  Author    : Elmar Pohl                                        *
C  Date      : 11.17.1991                                        *
C  Source    : FORTRAN 77                                        *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
      INTEGER IC(*), IR(*)
      DIMENSION V(*)
      CHARACTER*(*) FLNAM
C
      PARAMETER (IFLNO=8)
C
      OPEN (UNIT=IFLNO, FILE=FLNAM)
      READ (IFLNO, *) NROW
      if (nrow + 1 .gt. maxrow) then
        write (*,*) 'RDMTRX: Matrix too big (maximum: ',
     +              maxrow - 1, 'rows)!'
        stop
      end if
      NV = 0
      DO 10 I = 1, NROW
         IR(I) = NV + 1
   20    CONTINUE
            READ (IFLNO, *) IC0, V0
            IF (IC0 .EQ. 0) GOTO 10
            NV = NV + 1
            if (nv .gt. maxelm) then
              write (*,*) 'RDMTRX: Matrix has too many non-zero',
     +                    'elements (maximum: ', maxelm, ')!'
              stop
            end if
            V(NV) = V0
            IC(NV) = IC0
         GOTO 20
   10 CONTINUE
      CLOSE (IFLNO)
      IR(NROW + 1) = NV + 1
      RETURN
      END
C
C

      SUBROUTINE SRTDEG (NODE, IDEG, IBEG, IEND)
C
C*****************************************************************
C                                                                *
C  Subroutine for  SUBROUTINE CUTHIL.                            *
C  Sorts a partial list of nodes in the vector NODE according to *
C  increasing degrees.                                           *
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  NODE   : vector NODE(1:*) with node numbers. Each entry must  *
C           be an index of IDEG.                                 *
C  IDEG   : vector IDEG(1:*) with the node degrees. The node     *
C           NODE(I) has the degree   IDEG(NODE(I)).              *
C  IBEG   : starting index for the nodes that shall be sorted.   *
C  IEND   : final index of the nodes to be sorted                *
C                                                                *
C                                                                *
C  OUTPUT PARAMETER:                                             *
C  =================                                             *
C  NODE   : as on input, except for partial reordering           *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Required subroutines: none                                    *
C                                                                *
C*****************************************************************
C                                                                *
C  Author    : Elmar Pohl                                        *
C  Date      : 11.17.1991                                        *
C  Source    : FORTRAN 77                                        *
C                                                                *
C*****************************************************************
C
      INTEGER NODE(*), IDEG(*)
C
      DO 10 I = IBEG + 1, IEND
         NODE0 = NODE(I)
         IDEG0 = IDEG(NODE0)
C
         K0 = I
         DO 20 K = I - 1, IBEG, -1
            IF (IDEG0 .GE. IDEG(NODE(K))) GOTO 30
            NODE(K + 1) = NODE(K)
            K0 = K
   20    CONTINUE
   30    NODE(K0) = NODE0
   10 CONTINUE
      RETURN
      END


Begin of file
Contents
Index