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,
226 EXTERNAL lsame, slamch, slansb
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 )
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 sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine ssbtrd(VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, WORK, INFO)
SSBTRD
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine sstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSTEDC