SUBROUTINE DSTEVD( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
$ LIWORK, INFO )
*
* -- LAPACK driver routine (version 3.1) --
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
* November 2006
*
* .. Scalar Arguments ..
CHARACTER JOBZ
INTEGER INFO, LDZ, LIWORK, LWORK, N
* ..
* .. Array Arguments ..
INTEGER IWORK( * )
DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( LDZ, * )
* ..
*
* Purpose
* =======
*
* DSTEVD computes all eigenvalues and, optionally, eigenvectors of a
* real symmetric tridiagonal matrix. If eigenvectors are desired, it
* uses a divide and conquer algorithm.
*
* The divide and conquer algorithm makes very mild assumptions about
* floating point arithmetic. It will work on machines with a guard
* digit in add/subtract, or on those binary machines without guard
* digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
* Cray-2. It could conceivably fail on hexadecimal or decimal machines
* without guard digits, but we know of none.
*
* Arguments
* =========
*
* JOBZ (input) CHARACTER*1
* = 'N': Compute eigenvalues only;
* = 'V': Compute eigenvalues and eigenvectors.
*
* N (input) INTEGER
* The order of the matrix. N >= 0.
*
* D (input/output) DOUBLE PRECISION array, dimension (N)
* On entry, the n diagonal elements of the tridiagonal matrix
* A.
* On exit, if INFO = 0, the eigenvalues in ascending order.
*
* E (input/output) DOUBLE PRECISION array, dimension (N-1)
* On entry, the (n-1) subdiagonal elements of the tridiagonal
* matrix A, stored in elements 1 to N-1 of E.
* On exit, the contents of E are destroyed.
*
* Z (output) DOUBLE PRECISION array, dimension (LDZ, N)
* If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
* eigenvectors of the matrix A, with the i-th column of Z
* holding the eigenvector associated with D(i).
* If JOBZ = 'N', then Z is not referenced.
*
* LDZ (input) INTEGER
* The leading dimension of the array Z. LDZ >= 1, and if
* JOBZ = 'V', LDZ >= max(1,N).
*
* WORK (workspace/output) DOUBLE PRECISION array,
* dimension (LWORK)
* On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*
* LWORK (input) INTEGER
* The dimension of the array WORK.
* If JOBZ = 'N' or N <= 1 then LWORK must be at least 1.
* If JOBZ = 'V' and N > 1 then LWORK must be at least
* ( 1 + 4*N + N**2 ).
*
* If LWORK = -1, then a workspace query is assumed; the routine
* only calculates the optimal sizes of the WORK and IWORK
* arrays, returns these values as the first entries of the WORK
* and IWORK arrays, and no error message related to LWORK or
* LIWORK is issued by XERBLA.
*
* IWORK (workspace/output) INTEGER array, dimension (MAX(1,LIWORK))
* On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
*
* LIWORK (input) INTEGER
* The dimension of the array IWORK.
* If JOBZ = 'N' or N <= 1 then LIWORK must be at least 1.
* If JOBZ = 'V' and N > 1 then LIWORK must be at least 3+5*N.
*
* If LIWORK = -1, then a workspace query is assumed; the
* routine only calculates the optimal sizes of the WORK and
* IWORK arrays, returns these values as the first entries of
* the WORK and IWORK arrays, and no error message related to
* LWORK or LIWORK is issued by XERBLA.
*
* INFO (output) INTEGER
* = 0: successful exit
* < 0: if INFO = -i, the i-th argument had an illegal value
* > 0: if INFO = i, the algorithm failed to converge; i
* off-diagonal elements of E did not converge to zero.
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
* ..
* .. Local Scalars ..
LOGICAL LQUERY, WANTZ
INTEGER ISCALE, LIWMIN, LWMIN
DOUBLE PRECISION BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
$ TNRM
* ..
* .. External Functions ..
LOGICAL LSAME
DOUBLE PRECISION DLAMCH, DLANST
EXTERNAL LSAME, DLAMCH, DLANST
* ..
* .. External Subroutines ..
EXTERNAL DSCAL, DSTEDC, DSTERF, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC SQRT
* ..
* .. Executable Statements ..
*
* Test the input parameters.
*
WANTZ = LSAME( JOBZ, 'V' )
LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
*
INFO = 0
LIWMIN = 1
LWMIN = 1
IF( N.GT.1 .AND. WANTZ ) THEN
LWMIN = 1 + 4*N + N**2
LIWMIN = 3 + 5*N
END IF
*
IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
INFO = -2
ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
INFO = -6
END IF
*
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LWMIN
IWORK( 1 ) = LIWMIN
*
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
INFO = -8
ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
INFO = -10
END IF
END IF
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DSTEVD', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
*
* Quick return if possible
*
IF( N.EQ.0 )
$ RETURN
*
IF( N.EQ.1 ) THEN
IF( WANTZ )
$ Z( 1, 1 ) = ONE
RETURN
END IF
*
* Get machine constants.
*
SAFMIN = DLAMCH( 'Safe minimum' )
EPS = DLAMCH( 'Precision' )
SMLNUM = SAFMIN / EPS
BIGNUM = ONE / SMLNUM
RMIN = SQRT( SMLNUM )
RMAX = SQRT( BIGNUM )
*
* Scale matrix to allowable range, if necessary.
*
ISCALE = 0
TNRM = DLANST( 'M', N, D, E )
IF( TNRM.GT.ZERO .AND. TNRM.LT.RMIN ) THEN
ISCALE = 1
SIGMA = RMIN / TNRM
ELSE IF( TNRM.GT.RMAX ) THEN
ISCALE = 1
SIGMA = RMAX / TNRM
END IF
IF( ISCALE.EQ.1 ) THEN
CALL DSCAL( N, SIGMA, D, 1 )
CALL DSCAL( N-1, SIGMA, E( 1 ), 1 )
END IF
*
* For eigenvalues only, call DSTERF. For eigenvalues and
* eigenvectors, call DSTEDC.
*
IF( .NOT.WANTZ ) THEN
CALL DSTERF( N, D, E, INFO )
ELSE
CALL DSTEDC( 'I', N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK,
$ INFO )
END IF
*
* If matrix was scaled, then rescale eigenvalues appropriately.
*
IF( ISCALE.EQ.1 )
$ CALL DSCAL( N, ONE / SIGMA, D, 1 )
*
WORK( 1 ) = LWMIN
IWORK( 1 ) = LIWMIN
*
RETURN
*
* End of DSTEVD
*
END