1      SUBROUTINE DSTEV( JOBZ, N, D, E, Z, LDZ, WORK, INFO )
2*
3*  -- LAPACK driver routine (version 3.0) --
4*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
5*     Courant Institute, Argonne National Lab, and Rice University
6*     September 30, 1994
7*
8*     .. Scalar Arguments ..
9      CHARACTER          JOBZ
10      INTEGER            INFO, LDZ, N
11*     ..
12*     .. Array Arguments ..
13      DOUBLE PRECISION   D( * ), E( * ), WORK( * ), Z( LDZ, * )
14*     ..
15*
16*  Purpose
17*  =======
18*
19*  DSTEV computes all eigenvalues and, optionally, eigenvectors of a
20*  real symmetric tridiagonal matrix A.
21*
22*  Arguments
23*  =========
24*
25*  JOBZ    (input) CHARACTER*1
26*          = 'N':  Compute eigenvalues only;
27*          = 'V':  Compute eigenvalues and eigenvectors.
28*
29*  N       (input) INTEGER
30*          The order of the matrix.  N >= 0.
31*
32*  D       (input/output) DOUBLE PRECISION array, dimension (N)
33*          On entry, the n diagonal elements of the tridiagonal matrix
34*          A.
35*          On exit, if INFO = 0, the eigenvalues in ascending order.
36*
37*  E       (input/output) DOUBLE PRECISION array, dimension (N)
38*          On entry, the (n-1) subdiagonal elements of the tridiagonal
39*          matrix A, stored in elements 1 to N-1 of E; E(N) need not
40*          be set, but is used by the routine.
41*          On exit, the contents of E are destroyed.
42*
43*  Z       (output) DOUBLE PRECISION array, dimension (LDZ, N)
44*          If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
45*          eigenvectors of the matrix A, with the i-th column of Z
46*          holding the eigenvector associated with D(i).
47*          If JOBZ = 'N', then Z is not referenced.
48*
49*  LDZ     (input) INTEGER
50*          The leading dimension of the array Z.  LDZ >= 1, and if
51*          JOBZ = 'V', LDZ >= max(1,N).
52*
53*  WORK    (workspace) DOUBLE PRECISION array, dimension (max(1,2*N-2))
54*          If JOBZ = 'N', WORK is not referenced.
55*
56*  INFO    (output) INTEGER
57*          = 0:  successful exit
58*          < 0:  if INFO = -i, the i-th argument had an illegal value
59*          > 0:  if INFO = i, the algorithm failed to converge; i
60*                off-diagonal elements of E did not converge to zero.
61*
62*  =====================================================================
63*
64*     .. Parameters ..
65      DOUBLE PRECISION   ZERO, ONE
66      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
67*     ..
68*     .. Local Scalars ..
69      LOGICAL            WANTZ
70      INTEGER            IMAX, ISCALE
71      DOUBLE PRECISION   BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
72     $                   TNRM
73*     ..
74*     .. External Functions ..
75      LOGICAL            LSAME
76      DOUBLE PRECISION   DLAMCH, DLANST
77      EXTERNAL           LSAME, DLAMCH, DLANST
78*     ..
79*     .. External Subroutines ..
80      EXTERNAL           DSCAL, DSTEQR, DSTERF, XERBLA
81*     ..
82*     .. Intrinsic Functions ..
83      INTRINSIC          SQRT
84*     ..
85*     .. Executable Statements ..
86*
87*     Test the input parameters.
88*
89      WANTZ = LSAME( JOBZ, 'V' )
90*
91      INFO = 0
92      IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
93         INFO = -1
94      ELSE IF( N.LT.0 ) THEN
95         INFO = -2
96      ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
97         INFO = -6
98      END IF
99*
100      IF( INFO.NE.0 ) THEN
101         CALL XERBLA( 'DSTEV ', -INFO )
102         RETURN
103      END IF
104*
105*     Quick return if possible
106*
107      IF( N.EQ.0 )
108     $   RETURN
109*
110      IF( N.EQ.1 ) THEN
111         IF( WANTZ )
112     $      Z( 1, 1 ) = ONE
113         RETURN
114      END IF
115*
116*     Get machine constants.
117*
118      SAFMIN = DLAMCH( 'Safe minimum' )
119      EPS = DLAMCH( 'Precision' )
120      SMLNUM = SAFMIN / EPS
121      BIGNUM = ONE / SMLNUM
122      RMIN = SQRT( SMLNUM )
123      RMAX = SQRT( BIGNUM )
124*
125*     Scale matrix to allowable range, if necessary.
126*
127      ISCALE = 0
128      TNRM = DLANST( 'M', N, D, E )
129      IF( TNRM.GT.ZERO .AND. TNRM.LT.RMIN ) THEN
130         ISCALE = 1
131         SIGMA = RMIN / TNRM
132      ELSE IF( TNRM.GT.RMAX ) THEN
133         ISCALE = 1
134         SIGMA = RMAX / TNRM
135      END IF
136      IF( ISCALE.EQ.1 ) THEN
137         CALL DSCAL( N, SIGMA, D, 1 )
138         CALL DSCAL( N-1, SIGMA, E( 1 ), 1 )
139      END IF
140*
141*     For eigenvalues only, call DSTERF.  For eigenvalues and
142*     eigenvectors, call DSTEQR.
143*
144      IF( .NOT.WANTZ ) THEN
145         CALL DSTERF( N, D, E, INFO )
146      ELSE
147         CALL DSTEQR( 'I', N, D, E, Z, LDZ, WORK, INFO )
148      END IF
149*
150*     If matrix was scaled, then rescale eigenvalues appropriately.
151*
152      IF( ISCALE.EQ.1 ) THEN
153         IF( INFO.EQ.0 ) THEN
154            IMAX = N
155         ELSE
156            IMAX = INFO - 1
157         END IF
158         CALL DSCAL( IMAX, ONE / SIGMA, D, 1 )
159      END IF
160*
161      RETURN
162*
163*     End of DSTEV
164*
165      END
166