191 SUBROUTINE dsbevd( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
192 $ LWORK, IWORK, LIWORK, INFO )
200 INTEGER INFO, KD, LDAB, LDZ, LIWORK, LWORK, N
204 DOUBLE PRECISION AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
210 DOUBLE PRECISION ZERO, ONE
211 parameter( zero = 0.0d+0, one = 1.0d+0 )
214 LOGICAL LOWER, LQUERY, WANTZ
215 INTEGER IINFO, INDE, INDWK2, INDWRK, ISCALE, LIWMIN,
217 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
222 DOUBLE PRECISION DLAMCH, DLANSB
223 EXTERNAL lsame, dlamch, dlansb
236 wantz = lsame( jobz,
'V' )
237 lower = lsame( uplo,
'L' )
238 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
247 lwmin = 1 + 5*n + 2*n**2
253 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
255 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
257 ELSE IF( n.LT.0 )
THEN
259 ELSE IF( kd.LT.0 )
THEN
261 ELSE IF( ldab.LT.kd+1 )
THEN
263 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
271 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
273 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
279 CALL xerbla(
'DSBEVD', -info )
281 ELSE IF( lquery )
THEN
299 safmin = dlamch(
'Safe minimum' )
300 eps = dlamch(
'Precision' )
301 smlnum = safmin / eps
302 bignum = one / smlnum
303 rmin = sqrt( smlnum )
304 rmax = sqrt( bignum )
308 anrm = dlansb(
'M', uplo, n, kd, ab, ldab, work )
310 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
313 ELSE IF( anrm.GT.rmax )
THEN
317 IF( iscale.EQ.1 )
THEN
319 CALL dlascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
321 CALL dlascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
329 indwk2 = indwrk + n*n
330 llwrk2 = lwork - indwk2 + 1
331 CALL dsbtrd( jobz, uplo, n, kd, ab, ldab, w, work( inde ), z, ldz,
332 $ work( indwrk ), iinfo )
336 IF( .NOT.wantz )
THEN
337 CALL dsterf( n, w, work( inde ), info )
339 CALL dstedc(
'I', n, w, work( inde ), work( indwrk ), n,
340 $ work( indwk2 ), llwrk2, iwork, liwork, info )
341 CALL dgemm(
'N',
'N', n, n, n, one, z, ldz, work( indwrk ), n,
342 $ zero, work( indwk2 ), n )
343 CALL dlacpy(
'A', n, n, work( indwk2 ), n, z, ldz )
349 $
CALL dscal( n, one / sigma, w, 1 )
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSTEDC
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
subroutine dsbtrd(VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, WORK, INFO)
DSBTRD
subroutine dsbevd(JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSBEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...