142 SUBROUTINE dsbev( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
151 INTEGER INFO, KD, LDAB, LDZ, N
154 DOUBLE PRECISION AB( LDAB, * ), W( * ), WORK( * ), Z( LDZ, * )
160 DOUBLE PRECISION ZERO, ONE
161 parameter( zero = 0.0d0, one = 1.0d0 )
165 INTEGER IINFO, IMAX, INDE, INDWRK, ISCALE
166 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
171 DOUBLE PRECISION DLAMCH, DLANSB
172 EXTERNAL lsame, dlamch, dlansb
185 wantz = lsame( jobz,
'V' )
186 lower = lsame( uplo,
'L' )
189 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
191 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
193 ELSE IF( n.LT.0 )
THEN
195 ELSE IF( kd.LT.0 )
THEN
197 ELSE IF( ldab.LT.kd+1 )
THEN
199 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
204 CALL xerbla(
'DSBEV ', -info )
217 w( 1 ) = ab( kd+1, 1 )
226 safmin = dlamch(
'Safe minimum' )
227 eps = dlamch(
'Precision' )
228 smlnum = safmin / eps
229 bignum = one / smlnum
230 rmin = sqrt( smlnum )
231 rmax = sqrt( bignum )
235 anrm = dlansb(
'M', uplo, n, kd, ab, ldab, work )
237 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
240 ELSE IF( anrm.GT.rmax )
THEN
244 IF( iscale.EQ.1 )
THEN
246 CALL dlascl(
'B', kd, kd, one, sigma, n, n, ab, ldab,
249 CALL dlascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab,
258 CALL dsbtrd( jobz, uplo, n, kd, ab, ldab, w, work( inde ), z,
260 $ work( indwrk ), iinfo )
264 IF( .NOT.wantz )
THEN
265 CALL dsterf( n, w, work( inde ), info )
267 CALL dsteqr( jobz, n, w, work( inde ), z, ldz,
274 IF( iscale.EQ.1 )
THEN
280 CALL dscal( imax, one / sigma, w, 1 )
subroutine dsbev(jobz, uplo, n, kd, ab, ldab, w, z, ldz, work, info)
DSBEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices
subroutine dsbtrd(vect, uplo, n, kd, ab, ldab, d, e, q, ldq, work, info)
DSBTRD
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.