1      SUBROUTINE RSB(NM,N,MB,A,W,MATZ,Z,FV1,FV2,IERR)
2C***BEGIN PROLOGUE  RSB
3C***DATE WRITTEN   760101   (YYMMDD)
4C***REVISION DATE  830518   (YYMMDD)
5C***CATEGORY NO.  D4A6
6C***KEYWORDS  EIGENVALUES,EIGENVECTORS,EISPACK
7C***AUTHOR  SMITH, B. T., ET AL.
8C***PURPOSE  Computes eigenvalues and, optionally, eigenvectors of
9C            symmetric band matrix
10C***DESCRIPTION
11C
12C     This subroutine calls the recommended sequence of
13C     subroutines from the eigensystem subroutine package (EISPACK)
14C     to find the eigenvalues and eigenvectors (if desired)
15C     of a REAL SYMMETRIC BAND matrix.
16C
17C     On Input
18C
19C        NM  must be set to the row dimension of the two-dimensional
20C        array parameters as declared in the calling program
21C        dimension statement.
22C
23C        N  is the order of the matrix  A.
24C
25C        MB  is the half band width of the matrix, defined as the
26C        number of adjacent diagonals, including the principal
27C        diagonal, required to specify the non-zero portion of the
28C        lower triangle of the matrix.
29C
30C        A  contains the lower triangle of the real symmetric
31C        band matrix.  Its lowest subdiagonal is stored in the
32C        last  N+1-MB  positions of the first column, its next
33C        subdiagonal in the last  N+2-MB  positions of the
34C        second column, further subdiagonals similarly, and
35C        finally its principal diagonal in the  N  positions
36C        of the last column.  Contents of storages not part
37C        of the matrix are arbitrary.
38C
39C        MATZ  is an integer variable set equal to zero if
40C        only eigenvalues are desired.  Otherwise it is set to
41C        any non-zero integer for both eigenvalues and eigenvectors.
42C
43C     On Output
44C
45C        W  contains the eigenvalues in ascending order.
46C
47C        Z  contains the eigenvectors if MATZ is not zero.
48C
49C        IERR  is an integer output variable set equal to an
50C        error completion code described in section 2B of the
51C        documentation.  The normal completion code is zero.
52C
53C        FV1  and  FV2  are temporary storage arrays.
54C
55C     Questions and comments should be directed to B. S. Garbow,
56C     APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
57C     ------------------------------------------------------------------
58C***REFERENCES  B. T. SMITH, J. M. BOYLE, J. J. DONGARRA, B. S. GARBOW,
59C                 Y. IKEBE, V. C. KLEMA, C. B. MOLER, *MATRIX EIGEN-
60C                 SYSTEM ROUTINES - EISPACK GUIDE*, SPRINGER-VERLAG,
61C                 1976.
62C***ROUTINES CALLED  BANDR,TQL2,TQLRAT
63C***END PROLOGUE  RSB
64C
65      INTEGER N,MB,NM,IERR,MATZ
66      REAL A(NM,MB),W(N),Z(NM,N),FV1(N),FV2(N)
67      LOGICAL TF
68C
69C***FIRST EXECUTABLE STATEMENT  RSB
70      IF (N .LE. NM) GO TO 5
71      IERR = 10 * N
72      GO TO 50
73    5 IF (MB .GT. 0) GO TO 10
74      IERR = 12 * N
75      GO TO 50
76   10 IF (MB .LE. N) GO TO 15
77      IERR = 12 * N
78      GO TO 50
79C
80   15 IF (MATZ .NE. 0) GO TO 20
81C     .......... FIND EIGENVALUES ONLY ..........
82      TF = .FALSE.
83      CALL  BANDR(NM,N,MB,A,W,FV1,FV2,TF,Z)
84      CALL  TQLRAT(N,W,FV2,IERR)
85      GO TO 50
86C     .......... FIND BOTH EIGENVALUES AND EIGENVECTORS ..........
87   20 TF = .TRUE.
88      CALL  BANDR(NM,N,MB,A,W,FV1,FV1,TF,Z)
89      CALL  TQL2(NM,N,W,FV1,Z,IERR)
90   50 RETURN
91      END
92