215 SUBROUTINE chbevd( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
216 $ lwork, rwork, lrwork, iwork, liwork, info )
225 INTEGER info, kd, ldab, ldz, liwork, lrwork, lwork, n
229 REAL rwork( * ), w( * )
230 COMPLEX ab( ldab, * ), work( * ), z( ldz, * )
237 parameter( zero = 0.0e0, one = 1.0e0 )
239 parameter( czero = ( 0.0e0, 0.0e0 ),
240 $ cone = ( 1.0e0, 0.0e0 ) )
243 LOGICAL lower, lquery, wantz
244 INTEGER iinfo, imax, inde, indwk2, indwrk, iscale,
245 $ liwmin, llrwk, llwk2, lrwmin, lwmin
246 REAL anrm, bignum, eps, rmax, rmin, safmin, sigma,
265 wantz =
lsame( jobz,
'V' )
266 lower =
lsame( uplo,
'L' )
267 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 .OR. lrwork.EQ.-1 )
277 lrwmin = 1 + 5*n + 2*n**2
285 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
287 ELSE IF( .NOT.( lower .OR.
lsame( uplo,
'U' ) ) )
THEN
289 ELSE IF( n.LT.0 )
THEN
291 ELSE IF( kd.LT.0 )
THEN
293 ELSE IF( ldab.LT.kd+1 )
THEN
295 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
304 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
306 ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery )
THEN
308 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
314 CALL
xerbla(
'CHBEVD', -info )
316 ELSE IF( lquery )
THEN
334 safmin =
slamch(
'Safe minimum' )
335 eps =
slamch(
'Precision' )
336 smlnum = safmin / eps
337 bignum = one / smlnum
338 rmin = sqrt( smlnum )
339 rmax = sqrt( bignum )
343 anrm =
clanhb(
'M', uplo, n, kd, ab, ldab, rwork )
345 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
348 ELSE IF( anrm.GT.rmax )
THEN
352 IF( iscale.EQ.1 )
THEN
354 CALL
clascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
356 CALL
clascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
365 llwk2 = lwork - indwk2 + 1
366 llrwk = lrwork - indwrk + 1
367 CALL
chbtrd( jobz, uplo, n, kd, ab, ldab, w, rwork( inde ), z,
372 IF( .NOT.wantz )
THEN
373 CALL
ssterf( n, w, rwork( inde ), info )
375 CALL
cstedc(
'I', n, w, rwork( inde ), work, n, work( indwk2 ),
376 $ llwk2, rwork( indwrk ), llrwk, iwork, liwork,
378 CALL
cgemm(
'N',
'N', n, n, n, cone, z, ldz, work, n, czero,
379 $ work( indwk2 ), n )
380 CALL
clacpy(
'A', n, n, work( indwk2 ), n, z, ldz )
385 IF( iscale.EQ.1 )
THEN
391 CALL
sscal( imax, one / sigma, w, 1 )
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
subroutine cstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
CSTEDC
subroutine chbevd(JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
CHBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine chbtrd(VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, WORK, INFO)
CHBTRD
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine clascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
REAL function clanhb(NORM, UPLO, N, K, AB, LDAB, WORK)
CLANHB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a Hermitian band matrix.
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine sscal(N, SA, SX, INCX)
SSCAL