001:       SUBROUTINE CHBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
002:      $                  RWORK, INFO )
003: *
004: *  -- LAPACK driver routine (version 3.2) --
005: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
006: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
007: *     November 2006
008: *
009: *     .. Scalar Arguments ..
010:       CHARACTER          JOBZ, UPLO
011:       INTEGER            INFO, KD, LDAB, LDZ, N
012: *     ..
013: *     .. Array Arguments ..
014:       REAL               RWORK( * ), W( * )
015:       COMPLEX            AB( LDAB, * ), WORK( * ), Z( LDZ, * )
016: *     ..
017: *
018: *  Purpose
019: *  =======
020: *
021: *  CHBEV computes all the eigenvalues and, optionally, eigenvectors of
022: *  a complex Hermitian band matrix A.
023: *
024: *  Arguments
025: *  =========
026: *
027: *  JOBZ    (input) CHARACTER*1
028: *          = 'N':  Compute eigenvalues only;
029: *          = 'V':  Compute eigenvalues and eigenvectors.
030: *
031: *  UPLO    (input) CHARACTER*1
032: *          = 'U':  Upper triangle of A is stored;
033: *          = 'L':  Lower triangle of A is stored.
034: *
035: *  N       (input) INTEGER
036: *          The order of the matrix A.  N >= 0.
037: *
038: *  KD      (input) INTEGER
039: *          The number of superdiagonals of the matrix A if UPLO = 'U',
040: *          or the number of subdiagonals if UPLO = 'L'.  KD >= 0.
041: *
042: *  AB      (input/output) COMPLEX array, dimension (LDAB, N)
043: *          On entry, the upper or lower triangle of the Hermitian band
044: *          matrix A, stored in the first KD+1 rows of the array.  The
045: *          j-th column of A is stored in the j-th column of the array AB
046: *          as follows:
047: *          if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
048: *          if UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
049: *
050: *          On exit, AB is overwritten by values generated during the
051: *          reduction to tridiagonal form.  If UPLO = 'U', the first
052: *          superdiagonal and the diagonal of the tridiagonal matrix T
053: *          are returned in rows KD and KD+1 of AB, and if UPLO = 'L',
054: *          the diagonal and first subdiagonal of T are returned in the
055: *          first two rows of AB.
056: *
057: *  LDAB    (input) INTEGER
058: *          The leading dimension of the array AB.  LDAB >= KD + 1.
059: *
060: *  W       (output) REAL array, dimension (N)
061: *          If INFO = 0, the eigenvalues in ascending order.
062: *
063: *  Z       (output) COMPLEX array, dimension (LDZ, N)
064: *          If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
065: *          eigenvectors of the matrix A, with the i-th column of Z
066: *          holding the eigenvector associated with W(i).
067: *          If JOBZ = 'N', then Z is not referenced.
068: *
069: *  LDZ     (input) INTEGER
070: *          The leading dimension of the array Z.  LDZ >= 1, and if
071: *          JOBZ = 'V', LDZ >= max(1,N).
072: *
073: *  WORK    (workspace) COMPLEX array, dimension (N)
074: *
075: *  RWORK   (workspace) REAL array, dimension (max(1,3*N-2))
076: *
077: *  INFO    (output) INTEGER
078: *          = 0:  successful exit.
079: *          < 0:  if INFO = -i, the i-th argument had an illegal value.
080: *          > 0:  if INFO = i, the algorithm failed to converge; i
081: *                off-diagonal elements of an intermediate tridiagonal
082: *                form did not converge to zero.
083: *
084: *  =====================================================================
085: *
086: *     .. Parameters ..
087:       REAL               ZERO, ONE
088:       PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
089: *     ..
090: *     .. Local Scalars ..
091:       LOGICAL            LOWER, WANTZ
092:       INTEGER            IINFO, IMAX, INDE, INDRWK, ISCALE
093:       REAL               ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
094:      $                   SMLNUM
095: *     ..
096: *     .. External Functions ..
097:       LOGICAL            LSAME
098:       REAL               CLANHB, SLAMCH
099:       EXTERNAL           LSAME, CLANHB, SLAMCH
100: *     ..
101: *     .. External Subroutines ..
102:       EXTERNAL           CHBTRD, CLASCL, CSTEQR, SSCAL, SSTERF, XERBLA
103: *     ..
104: *     .. Intrinsic Functions ..
105:       INTRINSIC          SQRT
106: *     ..
107: *     .. Executable Statements ..
108: *
109: *     Test the input parameters.
110: *
111:       WANTZ = LSAME( JOBZ, 'V' )
112:       LOWER = LSAME( UPLO, 'L' )
113: *
114:       INFO = 0
115:       IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
116:          INFO = -1
117:       ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
118:          INFO = -2
119:       ELSE IF( N.LT.0 ) THEN
120:          INFO = -3
121:       ELSE IF( KD.LT.0 ) THEN
122:          INFO = -4
123:       ELSE IF( LDAB.LT.KD+1 ) THEN
124:          INFO = -6
125:       ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
126:          INFO = -9
127:       END IF
128: *
129:       IF( INFO.NE.0 ) THEN
130:          CALL XERBLA( 'CHBEV ', -INFO )
131:          RETURN
132:       END IF
133: *
134: *     Quick return if possible
135: *
136:       IF( N.EQ.0 )
137:      $   RETURN
138: *
139:       IF( N.EQ.1 ) THEN
140:          IF( LOWER ) THEN
141:             W( 1 ) = AB( 1, 1 )
142:          ELSE
143:             W( 1 ) = AB( KD+1, 1 )
144:          END IF
145:          IF( WANTZ )
146:      $      Z( 1, 1 ) = ONE
147:          RETURN
148:       END IF
149: *
150: *     Get machine constants.
151: *
152:       SAFMIN = SLAMCH( 'Safe minimum' )
153:       EPS = SLAMCH( 'Precision' )
154:       SMLNUM = SAFMIN / EPS
155:       BIGNUM = ONE / SMLNUM
156:       RMIN = SQRT( SMLNUM )
157:       RMAX = SQRT( BIGNUM )
158: *
159: *     Scale matrix to allowable range, if necessary.
160: *
161:       ANRM = CLANHB( 'M', UPLO, N, KD, AB, LDAB, RWORK )
162:       ISCALE = 0
163:       IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
164:          ISCALE = 1
165:          SIGMA = RMIN / ANRM
166:       ELSE IF( ANRM.GT.RMAX ) THEN
167:          ISCALE = 1
168:          SIGMA = RMAX / ANRM
169:       END IF
170:       IF( ISCALE.EQ.1 ) THEN
171:          IF( LOWER ) THEN
172:             CALL CLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
173:          ELSE
174:             CALL CLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
175:          END IF
176:       END IF
177: *
178: *     Call CHBTRD to reduce Hermitian band matrix to tridiagonal form.
179: *
180:       INDE = 1
181:       CALL CHBTRD( JOBZ, UPLO, N, KD, AB, LDAB, W, RWORK( INDE ), Z,
182:      $             LDZ, WORK, IINFO )
183: *
184: *     For eigenvalues only, call SSTERF.  For eigenvectors, call CSTEQR.
185: *
186:       IF( .NOT.WANTZ ) THEN
187:          CALL SSTERF( N, W, RWORK( INDE ), INFO )
188:       ELSE
189:          INDRWK = INDE + N
190:          CALL CSTEQR( JOBZ, N, W, RWORK( INDE ), Z, LDZ,
191:      $                RWORK( INDRWK ), INFO )
192:       END IF
193: *
194: *     If matrix was scaled, then rescale eigenvalues appropriately.
195: *
196:       IF( ISCALE.EQ.1 ) THEN
197:          IF( INFO.EQ.0 ) THEN
198:             IMAX = N
199:          ELSE
200:             IMAX = INFO - 1
201:          END IF
202:          CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
203:       END IF
204: *
205:       RETURN
206: *
207: *     End of CHBEV
208: *
209:       END
210: