193 SUBROUTINE dsbevd( 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 DOUBLE PRECISION AB( ldab, * ), W( * ), WORK( * ), Z( ldz, * )
213 DOUBLE PRECISION ZERO, ONE
214 parameter ( zero = 0.0d+0, one = 1.0d+0 )
217 LOGICAL LOWER, LQUERY, WANTZ
218 INTEGER IINFO, INDE, INDWK2, INDWRK, ISCALE, LIWMIN,
220 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
225 DOUBLE PRECISION DLAMCH, DLANSB
226 EXTERNAL lsame, dlamch, dlansb
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(
'DSBEVD', -info )
284 ELSE IF( lquery )
THEN
302 safmin = dlamch(
'Safe minimum' )
303 eps = dlamch(
'Precision' )
304 smlnum = safmin / eps
305 bignum = one / smlnum
306 rmin = sqrt( smlnum )
307 rmax = sqrt( bignum )
311 anrm = dlansb(
'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 dlascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
324 CALL dlascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
332 indwk2 = indwrk + n*n
333 llwrk2 = lwork - indwk2 + 1
334 CALL dsbtrd( jobz, uplo, n, kd, ab, ldab, w, work( inde ), z, ldz,
335 $ work( indwrk ), iinfo )
339 IF( .NOT.wantz )
THEN
340 CALL dsterf( n, w, work( inde ), info )
342 CALL dstedc(
'I', n, w, work( inde ), work( indwrk ), n,
343 $ work( indwk2 ), llwrk2, iwork, liwork, info )
344 CALL dgemm(
'N',
'N', n, n, n, one, z, ldz, work( indwrk ), n,
345 $ zero, work( indwk2 ), n )
346 CALL dlacpy(
'A', n, n, work( indwk2 ), n, z, ldz )
352 $
CALL dscal( n, one / sigma, w, 1 )
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
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 matric...
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 dsterf(N, D, E, INFO)
DSTERF
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 xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSTEDC