LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine sstev ( character  JOBZ,
integer  N,
real, dimension( * )  D,
real, dimension( * )  E,
real, dimension( ldz, * )  Z,
integer  LDZ,
real, dimension( * )  WORK,
integer  INFO 
)

SSTEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices

Download SSTEV + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 SSTEV computes all eigenvalues and, optionally, eigenvectors of a
 real symmetric tridiagonal matrix A.
Parameters
[in]JOBZ
          JOBZ is CHARACTER*1
          = 'N':  Compute eigenvalues only;
          = 'V':  Compute eigenvalues and eigenvectors.
[in]N
          N is INTEGER
          The order of the matrix.  N >= 0.
[in,out]D
          D is REAL array, dimension (N)
          On entry, the n diagonal elements of the tridiagonal matrix
          A.
          On exit, if INFO = 0, the eigenvalues in ascending order.
[in,out]E
          E is REAL 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.
[out]Z
          Z is REAL 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.
[in]LDZ
          LDZ is INTEGER
          The leading dimension of the array Z.  LDZ >= 1, and if
          JOBZ = 'V', LDZ >= max(1,N).
[out]WORK
          WORK is REAL array, dimension (max(1,2*N-2))
          If JOBZ = 'N', WORK is not referenced.
[out]INFO
          INFO is 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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 118 of file sstev.f.

118 *
119 * -- LAPACK driver routine (version 3.4.0) --
120 * -- LAPACK is a software package provided by Univ. of Tennessee, --
121 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
122 * November 2011
123 *
124 * .. Scalar Arguments ..
125  CHARACTER jobz
126  INTEGER info, ldz, n
127 * ..
128 * .. Array Arguments ..
129  REAL d( * ), e( * ), work( * ), z( ldz, * )
130 * ..
131 *
132 * =====================================================================
133 *
134 * .. Parameters ..
135  REAL zero, one
136  parameter ( zero = 0.0e0, one = 1.0e0 )
137 * ..
138 * .. Local Scalars ..
139  LOGICAL wantz
140  INTEGER imax, iscale
141  REAL bignum, eps, rmax, rmin, safmin, sigma, smlnum,
142  $ tnrm
143 * ..
144 * .. External Functions ..
145  LOGICAL lsame
146  REAL slamch, slanst
147  EXTERNAL lsame, slamch, slanst
148 * ..
149 * .. External Subroutines ..
150  EXTERNAL sscal, ssteqr, ssterf, xerbla
151 * ..
152 * .. Intrinsic Functions ..
153  INTRINSIC sqrt
154 * ..
155 * .. Executable Statements ..
156 *
157 * Test the input parameters.
158 *
159  wantz = lsame( jobz, 'V' )
160 *
161  info = 0
162  IF( .NOT.( wantz .OR. lsame( jobz, 'N' ) ) ) THEN
163  info = -1
164  ELSE IF( n.LT.0 ) THEN
165  info = -2
166  ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) ) THEN
167  info = -6
168  END IF
169 *
170  IF( info.NE.0 ) THEN
171  CALL xerbla( 'SSTEV ', -info )
172  RETURN
173  END IF
174 *
175 * Quick return if possible
176 *
177  IF( n.EQ.0 )
178  $ RETURN
179 *
180  IF( n.EQ.1 ) THEN
181  IF( wantz )
182  $ z( 1, 1 ) = one
183  RETURN
184  END IF
185 *
186 * Get machine constants.
187 *
188  safmin = slamch( 'Safe minimum' )
189  eps = slamch( 'Precision' )
190  smlnum = safmin / eps
191  bignum = one / smlnum
192  rmin = sqrt( smlnum )
193  rmax = sqrt( bignum )
194 *
195 * Scale matrix to allowable range, if necessary.
196 *
197  iscale = 0
198  tnrm = slanst( 'M', n, d, e )
199  IF( tnrm.GT.zero .AND. tnrm.LT.rmin ) THEN
200  iscale = 1
201  sigma = rmin / tnrm
202  ELSE IF( tnrm.GT.rmax ) THEN
203  iscale = 1
204  sigma = rmax / tnrm
205  END IF
206  IF( iscale.EQ.1 ) THEN
207  CALL sscal( n, sigma, d, 1 )
208  CALL sscal( n-1, sigma, e( 1 ), 1 )
209  END IF
210 *
211 * For eigenvalues only, call SSTERF. For eigenvalues and
212 * eigenvectors, call SSTEQR.
213 *
214  IF( .NOT.wantz ) THEN
215  CALL ssterf( n, d, e, info )
216  ELSE
217  CALL ssteqr( 'I', n, d, e, z, ldz, work, info )
218  END IF
219 *
220 * If matrix was scaled, then rescale eigenvalues appropriately.
221 *
222  IF( iscale.EQ.1 ) THEN
223  IF( info.EQ.0 ) THEN
224  imax = n
225  ELSE
226  imax = info - 1
227  END IF
228  CALL sscal( imax, one / sigma, d, 1 )
229  END IF
230 *
231  RETURN
232 *
233 * End of SSTEV
234 *
real function slanst(NORM, N, D, E)
SLANST returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric tridiagonal matrix.
Definition: slanst.f:102
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine ssteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
SSTEQR
Definition: ssteqr.f:133
subroutine sscal(N, SA, SX, INCX)
SSCAL
Definition: sscal.f:55
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
subroutine ssterf(N, D, E, INFO)
SSTERF
Definition: ssterf.f:88
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function:

Here is the caller graph for this function: