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