KTH framework for Nek5000 toolboxes; testing version  0.0.1
dstev.f
Go to the documentation of this file.
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
subroutine dscal(n, da, dx, incx)
Definition: dscal.f:2
subroutine dsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
Definition: dsteqr.f:2
subroutine dsterf(N, D, E, INFO)
Definition: dsterf.f:2
subroutine dstev(JOBZ, N, D, E, Z, LDZ, WORK, INFO)
Definition: dstev.f:2
subroutine xerbla(SRNAME, INFO)
Definition: xerbla.f:2