LAPACK  3.7.1
LAPACK: Linear Algebra PACKage
ssyevr.f
Go to the documentation of this file.
1 *> \brief <b> SSYEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download SSYEVR + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssyevr.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssyevr.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssyevr.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE SSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
22 * ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK,
23 * IWORK, LIWORK, INFO )
24 *
25 * .. Scalar Arguments ..
26 * CHARACTER JOBZ, RANGE, UPLO
27 * INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N
28 * REAL ABSTOL, VL, VU
29 * ..
30 * .. Array Arguments ..
31 * INTEGER ISUPPZ( * ), IWORK( * )
32 * REAL A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
33 * ..
34 *
35 *
36 *> \par Purpose:
37 * =============
38 *>
39 *> \verbatim
40 *>
41 *> SSYEVR computes selected eigenvalues and, optionally, eigenvectors
42 *> of a real symmetric matrix A. Eigenvalues and eigenvectors can be
43 *> selected by specifying either a range of values or a range of
44 *> indices for the desired eigenvalues.
45 *>
46 *> SSYEVR first reduces the matrix A to tridiagonal form T with a call
47 *> to SSYTRD. Then, whenever possible, SSYEVR calls SSTEMR to compute
48 *> the eigenspectrum using Relatively Robust Representations. SSTEMR
49 *> computes eigenvalues by the dqds algorithm, while orthogonal
50 *> eigenvectors are computed from various "good" L D L^T representations
51 *> (also known as Relatively Robust Representations). Gram-Schmidt
52 *> orthogonalization is avoided as far as possible. More specifically,
53 *> the various steps of the algorithm are as follows.
54 *>
55 *> For each unreduced block (submatrix) of T,
56 *> (a) Compute T - sigma I = L D L^T, so that L and D
57 *> define all the wanted eigenvalues to high relative accuracy.
58 *> This means that small relative changes in the entries of D and L
59 *> cause only small relative changes in the eigenvalues and
60 *> eigenvectors. The standard (unfactored) representation of the
61 *> tridiagonal matrix T does not have this property in general.
62 *> (b) Compute the eigenvalues to suitable accuracy.
63 *> If the eigenvectors are desired, the algorithm attains full
64 *> accuracy of the computed eigenvalues only right before
65 *> the corresponding vectors have to be computed, see steps c) and d).
66 *> (c) For each cluster of close eigenvalues, select a new
67 *> shift close to the cluster, find a new factorization, and refine
68 *> the shifted eigenvalues to suitable accuracy.
69 *> (d) For each eigenvalue with a large enough relative separation compute
70 *> the corresponding eigenvector by forming a rank revealing twisted
71 *> factorization. Go back to (c) for any clusters that remain.
72 *>
73 *> The desired accuracy of the output can be specified by the input
74 *> parameter ABSTOL.
75 *>
76 *> For more details, see SSTEMR's documentation and:
77 *> - Inderjit S. Dhillon and Beresford N. Parlett: "Multiple representations
78 *> to compute orthogonal eigenvectors of symmetric tridiagonal matrices,"
79 *> Linear Algebra and its Applications, 387(1), pp. 1-28, August 2004.
80 *> - Inderjit Dhillon and Beresford Parlett: "Orthogonal Eigenvectors and
81 *> Relative Gaps," SIAM Journal on Matrix Analysis and Applications, Vol. 25,
82 *> 2004. Also LAPACK Working Note 154.
83 *> - Inderjit Dhillon: "A new O(n^2) algorithm for the symmetric
84 *> tridiagonal eigenvalue/eigenvector problem",
85 *> Computer Science Division Technical Report No. UCB/CSD-97-971,
86 *> UC Berkeley, May 1997.
87 *>
88 *>
89 *> Note 1 : SSYEVR calls SSTEMR when the full spectrum is requested
90 *> on machines which conform to the ieee-754 floating point standard.
91 *> SSYEVR calls SSTEBZ and SSTEIN on non-ieee machines and
92 *> when partial spectrum requests are made.
93 *>
94 *> Normal execution of SSTEMR may create NaNs and infinities and
95 *> hence may abort due to a floating point exception in environments
96 *> which do not handle NaNs and infinities in the ieee standard default
97 *> manner.
98 *> \endverbatim
99 *
100 * Arguments:
101 * ==========
102 *
103 *> \param[in] JOBZ
104 *> \verbatim
105 *> JOBZ is CHARACTER*1
106 *> = 'N': Compute eigenvalues only;
107 *> = 'V': Compute eigenvalues and eigenvectors.
108 *> \endverbatim
109 *>
110 *> \param[in] RANGE
111 *> \verbatim
112 *> RANGE is CHARACTER*1
113 *> = 'A': all eigenvalues will be found.
114 *> = 'V': all eigenvalues in the half-open interval (VL,VU]
115 *> will be found.
116 *> = 'I': the IL-th through IU-th eigenvalues will be found.
117 *> For RANGE = 'V' or 'I' and IU - IL < N - 1, SSTEBZ and
118 *> SSTEIN are called
119 *> \endverbatim
120 *>
121 *> \param[in] UPLO
122 *> \verbatim
123 *> UPLO is CHARACTER*1
124 *> = 'U': Upper triangle of A is stored;
125 *> = 'L': Lower triangle of A is stored.
126 *> \endverbatim
127 *>
128 *> \param[in] N
129 *> \verbatim
130 *> N is INTEGER
131 *> The order of the matrix A. N >= 0.
132 *> \endverbatim
133 *>
134 *> \param[in,out] A
135 *> \verbatim
136 *> A is REAL array, dimension (LDA, N)
137 *> On entry, the symmetric matrix A. If UPLO = 'U', the
138 *> leading N-by-N upper triangular part of A contains the
139 *> upper triangular part of the matrix A. If UPLO = 'L',
140 *> the leading N-by-N lower triangular part of A contains
141 *> the lower triangular part of the matrix A.
142 *> On exit, the lower triangle (if UPLO='L') or the upper
143 *> triangle (if UPLO='U') of A, including the diagonal, is
144 *> destroyed.
145 *> \endverbatim
146 *>
147 *> \param[in] LDA
148 *> \verbatim
149 *> LDA is INTEGER
150 *> The leading dimension of the array A. LDA >= max(1,N).
151 *> \endverbatim
152 *>
153 *> \param[in] VL
154 *> \verbatim
155 *> VL is REAL
156 *> If RANGE='V', the lower bound of the interval to
157 *> be searched for eigenvalues. VL < VU.
158 *> Not referenced if RANGE = 'A' or 'I'.
159 *> \endverbatim
160 *>
161 *> \param[in] VU
162 *> \verbatim
163 *> VU is REAL
164 *> If RANGE='V', the upper bound of the interval to
165 *> be searched for eigenvalues. VL < VU.
166 *> Not referenced if RANGE = 'A' or 'I'.
167 *> \endverbatim
168 *>
169 *> \param[in] IL
170 *> \verbatim
171 *> IL is INTEGER
172 *> If RANGE='I', the index of the
173 *> smallest eigenvalue to be returned.
174 *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
175 *> Not referenced if RANGE = 'A' or 'V'.
176 *> \endverbatim
177 *>
178 *> \param[in] IU
179 *> \verbatim
180 *> IU is INTEGER
181 *> If RANGE='I', the index of the
182 *> largest eigenvalue to be returned.
183 *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
184 *> Not referenced if RANGE = 'A' or 'V'.
185 *> \endverbatim
186 *>
187 *> \param[in] ABSTOL
188 *> \verbatim
189 *> ABSTOL is REAL
190 *> The absolute error tolerance for the eigenvalues.
191 *> An approximate eigenvalue is accepted as converged
192 *> when it is determined to lie in an interval [a,b]
193 *> of width less than or equal to
194 *>
195 *> ABSTOL + EPS * max( |a|,|b| ) ,
196 *>
197 *> where EPS is the machine precision. If ABSTOL is less than
198 *> or equal to zero, then EPS*|T| will be used in its place,
199 *> where |T| is the 1-norm of the tridiagonal matrix obtained
200 *> by reducing A to tridiagonal form.
201 *>
202 *> See "Computing Small Singular Values of Bidiagonal Matrices
203 *> with Guaranteed High Relative Accuracy," by Demmel and
204 *> Kahan, LAPACK Working Note #3.
205 *>
206 *> If high relative accuracy is important, set ABSTOL to
207 *> SLAMCH( 'Safe minimum' ). Doing so will guarantee that
208 *> eigenvalues are computed to high relative accuracy when
209 *> possible in future releases. The current code does not
210 *> make any guarantees about high relative accuracy, but
211 *> future releases will. See J. Barlow and J. Demmel,
212 *> "Computing Accurate Eigensystems of Scaled Diagonally
213 *> Dominant Matrices", LAPACK Working Note #7, for a discussion
214 *> of which matrices define their eigenvalues to high relative
215 *> accuracy.
216 *> \endverbatim
217 *>
218 *> \param[out] M
219 *> \verbatim
220 *> M is INTEGER
221 *> The total number of eigenvalues found. 0 <= M <= N.
222 *> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
223 *> \endverbatim
224 *>
225 *> \param[out] W
226 *> \verbatim
227 *> W is REAL array, dimension (N)
228 *> The first M elements contain the selected eigenvalues in
229 *> ascending order.
230 *> \endverbatim
231 *>
232 *> \param[out] Z
233 *> \verbatim
234 *> Z is REAL array, dimension (LDZ, max(1,M))
235 *> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
236 *> contain the orthonormal eigenvectors of the matrix A
237 *> corresponding to the selected eigenvalues, with the i-th
238 *> column of Z holding the eigenvector associated with W(i).
239 *> If JOBZ = 'N', then Z is not referenced.
240 *> Note: the user must ensure that at least max(1,M) columns are
241 *> supplied in the array Z; if RANGE = 'V', the exact value of M
242 *> is not known in advance and an upper bound must be used.
243 *> Supplying N columns is always safe.
244 *> \endverbatim
245 *>
246 *> \param[in] LDZ
247 *> \verbatim
248 *> LDZ is INTEGER
249 *> The leading dimension of the array Z. LDZ >= 1, and if
250 *> JOBZ = 'V', LDZ >= max(1,N).
251 *> \endverbatim
252 *>
253 *> \param[out] ISUPPZ
254 *> \verbatim
255 *> ISUPPZ is INTEGER array, dimension ( 2*max(1,M) )
256 *> The support of the eigenvectors in Z, i.e., the indices
257 *> indicating the nonzero elements in Z. The i-th eigenvector
258 *> is nonzero only in elements ISUPPZ( 2*i-1 ) through
259 *> ISUPPZ( 2*i ). This is an output of SSTEMR (tridiagonal
260 *> matrix). The support of the eigenvectors of A is typically
261 *> 1:N because of the orthogonal transformations applied by SORMTR.
262 *> Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1
263 *> \endverbatim
264 *>
265 *> \param[out] WORK
266 *> \verbatim
267 *> WORK is REAL array, dimension (MAX(1,LWORK))
268 *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
269 *> \endverbatim
270 *>
271 *> \param[in] LWORK
272 *> \verbatim
273 *> LWORK is INTEGER
274 *> The dimension of the array WORK. LWORK >= max(1,26*N).
275 *> For optimal efficiency, LWORK >= (NB+6)*N,
276 *> where NB is the max of the blocksize for SSYTRD and SORMTR
277 *> returned by ILAENV.
278 *>
279 *> If LWORK = -1, then a workspace query is assumed; the routine
280 *> only calculates the optimal sizes of the WORK and IWORK
281 *> arrays, returns these values as the first entries of the WORK
282 *> and IWORK arrays, and no error message related to LWORK or
283 *> LIWORK is issued by XERBLA.
284 *> \endverbatim
285 *>
286 *> \param[out] IWORK
287 *> \verbatim
288 *> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
289 *> On exit, if INFO = 0, IWORK(1) returns the optimal LWORK.
290 *> \endverbatim
291 *>
292 *> \param[in] LIWORK
293 *> \verbatim
294 *> LIWORK is INTEGER
295 *> The dimension of the array IWORK. LIWORK >= max(1,10*N).
296 *>
297 *> If LIWORK = -1, then a workspace query is assumed; the
298 *> routine only calculates the optimal sizes of the WORK and
299 *> IWORK arrays, returns these values as the first entries of
300 *> the WORK and IWORK arrays, and no error message related to
301 *> LWORK or LIWORK is issued by XERBLA.
302 *> \endverbatim
303 *>
304 *> \param[out] INFO
305 *> \verbatim
306 *> INFO is INTEGER
307 *> = 0: successful exit
308 *> < 0: if INFO = -i, the i-th argument had an illegal value
309 *> > 0: Internal error
310 *> \endverbatim
311 *
312 * Authors:
313 * ========
314 *
315 *> \author Univ. of Tennessee
316 *> \author Univ. of California Berkeley
317 *> \author Univ. of Colorado Denver
318 *> \author NAG Ltd.
319 *
320 *> \date June 2016
321 *
322 *> \ingroup realSYeigen
323 *
324 *> \par Contributors:
325 * ==================
326 *>
327 *> Inderjit Dhillon, IBM Almaden, USA \n
328 *> Osni Marques, LBNL/NERSC, USA \n
329 *> Ken Stanley, Computer Science Division, University of
330 *> California at Berkeley, USA \n
331 *> Jason Riedy, Computer Science Division, University of
332 *> California at Berkeley, USA \n
333 *>
334 * =====================================================================
335  SUBROUTINE ssyevr( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
336  $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK,
337  $ IWORK, LIWORK, INFO )
338 *
339 * -- LAPACK driver routine (version 3.7.0) --
340 * -- LAPACK is a software package provided by Univ. of Tennessee, --
341 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
342 * June 2016
343 *
344 * .. Scalar Arguments ..
345  CHARACTER JOBZ, RANGE, UPLO
346  INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N
347  REAL ABSTOL, VL, VU
348 * ..
349 * .. Array Arguments ..
350  INTEGER ISUPPZ( * ), IWORK( * )
351  REAL A( lda, * ), W( * ), WORK( * ), Z( ldz, * )
352 * ..
353 *
354 * =====================================================================
355 *
356 * .. Parameters ..
357  REAL ZERO, ONE, TWO
358  parameter( zero = 0.0e+0, one = 1.0e+0, two = 2.0e+0 )
359 * ..
360 * .. Local Scalars ..
361  LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
362  $ wantz, tryrac
363  CHARACTER ORDER
364  INTEGER I, IEEEOK, IINFO, IMAX, INDD, INDDD, INDE,
365  $ indee, indibl, indifl, indisp, indiwo, indtau,
366  $ indwk, indwkn, iscale, j, jj, liwmin,
367  $ llwork, llwrkn, lwkopt, lwmin, nb, nsplit
368  REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
369  $ sigma, smlnum, tmp1, vll, vuu
370 * ..
371 * .. External Functions ..
372  LOGICAL LSAME
373  INTEGER ILAENV
374  REAL SLAMCH, SLANSY
375  EXTERNAL lsame, ilaenv, slamch, slansy
376 * ..
377 * .. External Subroutines ..
378  EXTERNAL scopy, sormtr, sscal, sstebz, sstemr, sstein,
380 * ..
381 * .. Intrinsic Functions ..
382  INTRINSIC max, min, sqrt
383 * ..
384 * .. Executable Statements ..
385 *
386 * Test the input parameters.
387 *
388  ieeeok = ilaenv( 10, 'SSYEVR', 'N', 1, 2, 3, 4 )
389 *
390  lower = lsame( uplo, 'L' )
391  wantz = lsame( jobz, 'V' )
392  alleig = lsame( range, 'A' )
393  valeig = lsame( range, 'V' )
394  indeig = lsame( range, 'I' )
395 *
396  lquery = ( ( lwork.EQ.-1 ) .OR. ( liwork.EQ.-1 ) )
397 *
398  lwmin = max( 1, 26*n )
399  liwmin = max( 1, 10*n )
400 *
401  info = 0
402  IF( .NOT.( wantz .OR. lsame( jobz, 'N' ) ) ) THEN
403  info = -1
404  ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) ) THEN
405  info = -2
406  ELSE IF( .NOT.( lower .OR. lsame( uplo, 'U' ) ) ) THEN
407  info = -3
408  ELSE IF( n.LT.0 ) THEN
409  info = -4
410  ELSE IF( lda.LT.max( 1, n ) ) THEN
411  info = -6
412  ELSE
413  IF( valeig ) THEN
414  IF( n.GT.0 .AND. vu.LE.vl )
415  $ info = -8
416  ELSE IF( indeig ) THEN
417  IF( il.LT.1 .OR. il.GT.max( 1, n ) ) THEN
418  info = -9
419  ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n ) THEN
420  info = -10
421  END IF
422  END IF
423  END IF
424  IF( info.EQ.0 ) THEN
425  IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) ) THEN
426  info = -15
427  END IF
428  END IF
429 *
430  IF( info.EQ.0 ) THEN
431  nb = ilaenv( 1, 'SSYTRD', uplo, n, -1, -1, -1 )
432  nb = max( nb, ilaenv( 1, 'SORMTR', uplo, n, -1, -1, -1 ) )
433  lwkopt = max( ( nb+1 )*n, lwmin )
434  work( 1 ) = lwkopt
435  iwork( 1 ) = liwmin
436 *
437  IF( lwork.LT.lwmin .AND. .NOT.lquery ) THEN
438  info = -18
439  ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery ) THEN
440  info = -20
441  END IF
442  END IF
443 *
444  IF( info.NE.0 ) THEN
445  CALL xerbla( 'SSYEVR', -info )
446  RETURN
447  ELSE IF( lquery ) THEN
448  RETURN
449  END IF
450 *
451 * Quick return if possible
452 *
453  m = 0
454  IF( n.EQ.0 ) THEN
455  work( 1 ) = 1
456  RETURN
457  END IF
458 *
459  IF( n.EQ.1 ) THEN
460  work( 1 ) = 26
461  IF( alleig .OR. indeig ) THEN
462  m = 1
463  w( 1 ) = a( 1, 1 )
464  ELSE
465  IF( vl.LT.a( 1, 1 ) .AND. vu.GE.a( 1, 1 ) ) THEN
466  m = 1
467  w( 1 ) = a( 1, 1 )
468  END IF
469  END IF
470  IF( wantz ) THEN
471  z( 1, 1 ) = one
472  isuppz( 1 ) = 1
473  isuppz( 2 ) = 1
474  END IF
475  RETURN
476  END IF
477 *
478 * Get machine constants.
479 *
480  safmin = slamch( 'Safe minimum' )
481  eps = slamch( 'Precision' )
482  smlnum = safmin / eps
483  bignum = one / smlnum
484  rmin = sqrt( smlnum )
485  rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
486 *
487 * Scale matrix to allowable range, if necessary.
488 *
489  iscale = 0
490  abstll = abstol
491  IF (valeig) THEN
492  vll = vl
493  vuu = vu
494  END IF
495  anrm = slansy( 'M', uplo, n, a, lda, work )
496  IF( anrm.GT.zero .AND. anrm.LT.rmin ) THEN
497  iscale = 1
498  sigma = rmin / anrm
499  ELSE IF( anrm.GT.rmax ) THEN
500  iscale = 1
501  sigma = rmax / anrm
502  END IF
503  IF( iscale.EQ.1 ) THEN
504  IF( lower ) THEN
505  DO 10 j = 1, n
506  CALL sscal( n-j+1, sigma, a( j, j ), 1 )
507  10 CONTINUE
508  ELSE
509  DO 20 j = 1, n
510  CALL sscal( j, sigma, a( 1, j ), 1 )
511  20 CONTINUE
512  END IF
513  IF( abstol.GT.0 )
514  $ abstll = abstol*sigma
515  IF( valeig ) THEN
516  vll = vl*sigma
517  vuu = vu*sigma
518  END IF
519  END IF
520 
521 * Initialize indices into workspaces. Note: The IWORK indices are
522 * used only if SSTERF or SSTEMR fail.
523 
524 * WORK(INDTAU:INDTAU+N-1) stores the scalar factors of the
525 * elementary reflectors used in SSYTRD.
526  indtau = 1
527 * WORK(INDD:INDD+N-1) stores the tridiagonal's diagonal entries.
528  indd = indtau + n
529 * WORK(INDE:INDE+N-1) stores the off-diagonal entries of the
530 * tridiagonal matrix from SSYTRD.
531  inde = indd + n
532 * WORK(INDDD:INDDD+N-1) is a copy of the diagonal entries over
533 * -written by SSTEMR (the SSTERF path copies the diagonal to W).
534  inddd = inde + n
535 * WORK(INDEE:INDEE+N-1) is a copy of the off-diagonal entries over
536 * -written while computing the eigenvalues in SSTERF and SSTEMR.
537  indee = inddd + n
538 * INDWK is the starting offset of the left-over workspace, and
539 * LLWORK is the remaining workspace size.
540  indwk = indee + n
541  llwork = lwork - indwk + 1
542 
543 * IWORK(INDIBL:INDIBL+M-1) corresponds to IBLOCK in SSTEBZ and
544 * stores the block indices of each of the M<=N eigenvalues.
545  indibl = 1
546 * IWORK(INDISP:INDISP+NSPLIT-1) corresponds to ISPLIT in SSTEBZ and
547 * stores the starting and finishing indices of each block.
548  indisp = indibl + n
549 * IWORK(INDIFL:INDIFL+N-1) stores the indices of eigenvectors
550 * that corresponding to eigenvectors that fail to converge in
551 * SSTEIN. This information is discarded; if any fail, the driver
552 * returns INFO > 0.
553  indifl = indisp + n
554 * INDIWO is the offset of the remaining integer workspace.
555  indiwo = indifl + n
556 
557 *
558 * Call SSYTRD to reduce symmetric matrix to tridiagonal form.
559 *
560  CALL ssytrd( uplo, n, a, lda, work( indd ), work( inde ),
561  $ work( indtau ), work( indwk ), llwork, iinfo )
562 *
563 * If all eigenvalues are desired
564 * then call SSTERF or SSTEMR and SORMTR.
565 *
566  test = .false.
567  IF( indeig ) THEN
568  IF( il.EQ.1 .AND. iu.EQ.n ) THEN
569  test = .true.
570  END IF
571  END IF
572  IF( ( alleig.OR.test ) .AND. ( ieeeok.EQ.1 ) ) THEN
573  IF( .NOT.wantz ) THEN
574  CALL scopy( n, work( indd ), 1, w, 1 )
575  CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
576  CALL ssterf( n, w, work( indee ), info )
577  ELSE
578  CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
579  CALL scopy( n, work( indd ), 1, work( inddd ), 1 )
580 *
581  IF (abstol .LE. two*n*eps) THEN
582  tryrac = .true.
583  ELSE
584  tryrac = .false.
585  END IF
586  CALL sstemr( jobz, 'A', n, work( inddd ), work( indee ),
587  $ vl, vu, il, iu, m, w, z, ldz, n, isuppz,
588  $ tryrac, work( indwk ), lwork, iwork, liwork,
589  $ info )
590 *
591 *
592 *
593 * Apply orthogonal matrix used in reduction to tridiagonal
594 * form to eigenvectors returned by SSTEMR.
595 *
596  IF( wantz .AND. info.EQ.0 ) THEN
597  indwkn = inde
598  llwrkn = lwork - indwkn + 1
599  CALL sormtr( 'L', uplo, 'N', n, m, a, lda,
600  $ work( indtau ), z, ldz, work( indwkn ),
601  $ llwrkn, iinfo )
602  END IF
603  END IF
604 *
605 *
606  IF( info.EQ.0 ) THEN
607 * Everything worked. Skip SSTEBZ/SSTEIN. IWORK(:) are
608 * undefined.
609  m = n
610  GO TO 30
611  END IF
612  info = 0
613  END IF
614 *
615 * Otherwise, call SSTEBZ and, if eigenvectors are desired, SSTEIN.
616 * Also call SSTEBZ and SSTEIN if SSTEMR fails.
617 *
618  IF( wantz ) THEN
619  order = 'B'
620  ELSE
621  order = 'E'
622  END IF
623 
624  CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
625  $ work( indd ), work( inde ), m, nsplit, w,
626  $ iwork( indibl ), iwork( indisp ), work( indwk ),
627  $ iwork( indiwo ), info )
628 *
629  IF( wantz ) THEN
630  CALL sstein( n, work( indd ), work( inde ), m, w,
631  $ iwork( indibl ), iwork( indisp ), z, ldz,
632  $ work( indwk ), iwork( indiwo ), iwork( indifl ),
633  $ info )
634 *
635 * Apply orthogonal matrix used in reduction to tridiagonal
636 * form to eigenvectors returned by SSTEIN.
637 *
638  indwkn = inde
639  llwrkn = lwork - indwkn + 1
640  CALL sormtr( 'L', uplo, 'N', n, m, a, lda, work( indtau ), z,
641  $ ldz, work( indwkn ), llwrkn, iinfo )
642  END IF
643 *
644 * If matrix was scaled, then rescale eigenvalues appropriately.
645 *
646 * Jump here if SSTEMR/SSTEIN succeeded.
647  30 CONTINUE
648  IF( iscale.EQ.1 ) THEN
649  IF( info.EQ.0 ) THEN
650  imax = m
651  ELSE
652  imax = info - 1
653  END IF
654  CALL sscal( imax, one / sigma, w, 1 )
655  END IF
656 *
657 * If eigenvalues are not in order, then sort them, along with
658 * eigenvectors. Note: We do not sort the IFAIL portion of IWORK.
659 * It may not be initialized (if SSTEMR/SSTEIN succeeded), and we do
660 * not return this detailed information to the user.
661 *
662  IF( wantz ) THEN
663  DO 50 j = 1, m - 1
664  i = 0
665  tmp1 = w( j )
666  DO 40 jj = j + 1, m
667  IF( w( jj ).LT.tmp1 ) THEN
668  i = jj
669  tmp1 = w( jj )
670  END IF
671  40 CONTINUE
672 *
673  IF( i.NE.0 ) THEN
674  w( i ) = w( j )
675  w( j ) = tmp1
676  CALL sswap( n, z( 1, i ), 1, z( 1, j ), 1 )
677  END IF
678  50 CONTINUE
679  END IF
680 *
681 * Set WORK(1) to optimal workspace size.
682 *
683  work( 1 ) = lwkopt
684  iwork( 1 ) = liwmin
685 *
686  RETURN
687 *
688 * End of SSYEVR
689 *
690  END
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
Definition: sstebz.f:275
subroutine ssytrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
SSYTRD
Definition: ssytrd.f:194
subroutine sormtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMTR
Definition: sormtr.f:174
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine ssyevr(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSYEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices ...
Definition: ssyevr.f:338
subroutine sstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSTEIN
Definition: sstein.f:176
subroutine sscal(N, SA, SX, INCX)
SSCAL
Definition: sscal.f:81
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
Definition: sswap.f:84
subroutine ssterf(N, D, E, INFO)
SSTERF
Definition: ssterf.f:88
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
Definition: scopy.f:84
subroutine sstemr(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, IWORK, LIWORK, INFO)
SSTEMR
Definition: sstemr.f:323