179 SUBROUTINE dspevd( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK,
180 $ iwork, liwork, info )
189 INTEGER info, ldz, liwork, lwork, n
193 DOUBLE PRECISION ap( * ), w( * ), work( * ), z( ldz, * )
199 DOUBLE PRECISION zero, one
200 parameter( zero = 0.0d+0, one = 1.0d+0 )
203 LOGICAL lquery, wantz
204 INTEGER iinfo, inde, indtau, indwrk, iscale, liwmin,
206 DOUBLE PRECISION anrm, bignum, eps, rmax, rmin, safmin, sigma,
224 wantz =
lsame( jobz,
'V' )
225 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
228 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
230 ELSE IF( .NOT.(
lsame( uplo,
'U' ) .OR.
lsame( uplo,
'L' ) ) )
233 ELSE IF( n.LT.0 )
THEN
235 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
246 lwmin = 1 + 6*n + n**2
255 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
257 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
263 CALL
xerbla(
'DSPEVD', -info )
265 ELSE IF( lquery )
THEN
283 safmin =
dlamch(
'Safe minimum' )
284 eps =
dlamch(
'Precision' )
285 smlnum = safmin / eps
286 bignum = one / smlnum
287 rmin = sqrt( smlnum )
288 rmax = sqrt( bignum )
292 anrm =
dlansp(
'M', uplo, n, ap, work )
294 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
297 ELSE IF( anrm.GT.rmax )
THEN
301 IF( iscale.EQ.1 )
THEN
302 CALL
dscal( ( n*( n+1 ) ) / 2, sigma, ap, 1 )
309 CALL
dsptrd( uplo, n, ap, w, work( inde ), work( indtau ), iinfo )
316 IF( .NOT.wantz )
THEN
317 CALL
dsterf( n, w, work( inde ), info )
320 llwork = lwork - indwrk + 1
321 CALL
dstedc(
'I', n, w, work( inde ), z, ldz, work( indwrk ),
322 $ llwork, iwork, liwork, info )
323 CALL
dopmtr(
'L', uplo,
'N', n, n, ap, work( indtau ), z, ldz,
324 $ work( indwrk ), iinfo )
330 $ CALL
dscal( n, one / sigma, w, 1 )