193 SUBROUTINE ssbevd( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
194 $ lwork, iwork, liwork, info )
203 INTEGER info, kd, ldab, ldz, liwork, lwork, n
207 REAL ab( ldab, * ), w( * ), work( * ), z( ldz, * )
214 parameter( zero = 0.0e+0, one = 1.0e+0 )
217 LOGICAL lower, lquery, wantz
218 INTEGER iinfo, inde, indwk2, indwrk, iscale, liwmin,
220 REAL anrm, bignum, eps, rmax, rmin, safmin, sigma,
239 wantz =
lsame( jobz,
'V' )
240 lower =
lsame( uplo,
'L' )
241 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
250 lwmin = 1 + 5*n + 2*n**2
256 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
258 ELSE IF( .NOT.( lower .OR.
lsame( uplo,
'U' ) ) )
THEN
260 ELSE IF( n.LT.0 )
THEN
262 ELSE IF( kd.LT.0 )
THEN
264 ELSE IF( ldab.LT.kd+1 )
THEN
266 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
274 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
276 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
282 CALL
xerbla(
'SSBEVD', -info )
284 ELSE IF( lquery )
THEN
302 safmin =
slamch(
'Safe minimum' )
303 eps =
slamch(
'Precision' )
304 smlnum = safmin / eps
305 bignum = one / smlnum
306 rmin = sqrt( smlnum )
307 rmax = sqrt( bignum )
311 anrm =
slansb(
'M', uplo, n, kd, ab, ldab, work )
313 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
316 ELSE IF( anrm.GT.rmax )
THEN
320 IF( iscale.EQ.1 )
THEN
322 CALL
slascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
324 CALL
slascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
332 indwk2 = indwrk + n*n
333 llwrk2 = lwork - indwk2 + 1
334 CALL
ssbtrd( jobz, uplo, n, kd, ab, ldab, w, work( inde ), z, ldz,
335 $ work( indwrk ), iinfo )
339 IF( .NOT.wantz )
THEN
340 CALL
ssterf( n, w, work( inde ), info )
342 CALL
sstedc(
'I', n, w, work( inde ), work( indwrk ), n,
343 $ work( indwk2 ), llwrk2, iwork, liwork, info )
344 CALL
sgemm(
'N',
'N', n, n, n, one, z, ldz, work( indwrk ), n,
345 $ zero, work( indwk2 ), n )
346 CALL
slacpy(
'A', n, n, work( indwk2 ), n, z, ldz )
352 $ CALL
sscal( n, one / sigma, w, 1 )
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
REAL function slansb(NORM, UPLO, N, K, AB, LDAB, WORK)
SLANSB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric band matrix.
subroutine ssbevd(JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSTEBZ
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine ssbtrd(VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, WORK, INFO)
SSBTRD
subroutine sscal(N, SA, SX, INCX)
SSCAL