LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
sspevx.f
Go to the documentation of this file.
1*> \brief <b> SSPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER 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 SSPEVX + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sspevx.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sspevx.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sspevx.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE SSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU,
22* ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL,
23* INFO )
24*
25* .. Scalar Arguments ..
26* CHARACTER JOBZ, RANGE, UPLO
27* INTEGER IL, INFO, IU, LDZ, M, N
28* REAL ABSTOL, VL, VU
29* ..
30* .. Array Arguments ..
31* INTEGER IFAIL( * ), IWORK( * )
32* REAL AP( * ), W( * ), WORK( * ), Z( LDZ, * )
33* ..
34*
35*
36*> \par Purpose:
37* =============
38*>
39*> \verbatim
40*>
41*> SSPEVX computes selected eigenvalues and, optionally, eigenvectors
42*> of a real symmetric matrix A in packed storage. Eigenvalues/vectors
43*> can be selected by specifying either a range of values or a range of
44*> indices for the desired eigenvalues.
45*> \endverbatim
46*
47* Arguments:
48* ==========
49*
50*> \param[in] JOBZ
51*> \verbatim
52*> JOBZ is CHARACTER*1
53*> = 'N': Compute eigenvalues only;
54*> = 'V': Compute eigenvalues and eigenvectors.
55*> \endverbatim
56*>
57*> \param[in] RANGE
58*> \verbatim
59*> RANGE is CHARACTER*1
60*> = 'A': all eigenvalues will be found;
61*> = 'V': all eigenvalues in the half-open interval (VL,VU]
62*> will be found;
63*> = 'I': the IL-th through IU-th eigenvalues will be found.
64*> \endverbatim
65*>
66*> \param[in] UPLO
67*> \verbatim
68*> UPLO is CHARACTER*1
69*> = 'U': Upper triangle of A is stored;
70*> = 'L': Lower triangle of A is stored.
71*> \endverbatim
72*>
73*> \param[in] N
74*> \verbatim
75*> N is INTEGER
76*> The order of the matrix A. N >= 0.
77*> \endverbatim
78*>
79*> \param[in,out] AP
80*> \verbatim
81*> AP is REAL array, dimension (N*(N+1)/2)
82*> On entry, the upper or lower triangle of the symmetric matrix
83*> A, packed columnwise in a linear array. The j-th column of A
84*> is stored in the array AP as follows:
85*> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
86*> if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
87*>
88*> On exit, AP is overwritten by values generated during the
89*> reduction to tridiagonal form. If UPLO = 'U', the diagonal
90*> and first superdiagonal of the tridiagonal matrix T overwrite
91*> the corresponding elements of A, and if UPLO = 'L', the
92*> diagonal and first subdiagonal of T overwrite the
93*> corresponding elements of A.
94*> \endverbatim
95*>
96*> \param[in] VL
97*> \verbatim
98*> VL is REAL
99*> If RANGE='V', the lower bound of the interval to
100*> be searched for eigenvalues. VL < VU.
101*> Not referenced if RANGE = 'A' or 'I'.
102*> \endverbatim
103*>
104*> \param[in] VU
105*> \verbatim
106*> VU is REAL
107*> If RANGE='V', the upper bound of the interval to
108*> be searched for eigenvalues. VL < VU.
109*> Not referenced if RANGE = 'A' or 'I'.
110*> \endverbatim
111*>
112*> \param[in] IL
113*> \verbatim
114*> IL is INTEGER
115*> If RANGE='I', the index of the
116*> smallest eigenvalue to be returned.
117*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
118*> Not referenced if RANGE = 'A' or 'V'.
119*> \endverbatim
120*>
121*> \param[in] IU
122*> \verbatim
123*> IU is INTEGER
124*> If RANGE='I', the index of the
125*> largest eigenvalue to be returned.
126*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
127*> Not referenced if RANGE = 'A' or 'V'.
128*> \endverbatim
129*>
130*> \param[in] ABSTOL
131*> \verbatim
132*> ABSTOL is REAL
133*> The absolute error tolerance for the eigenvalues.
134*> An approximate eigenvalue is accepted as converged
135*> when it is determined to lie in an interval [a,b]
136*> of width less than or equal to
137*>
138*> ABSTOL + EPS * max( |a|,|b| ) ,
139*>
140*> where EPS is the machine precision. If ABSTOL is less than
141*> or equal to zero, then EPS*|T| will be used in its place,
142*> where |T| is the 1-norm of the tridiagonal matrix obtained
143*> by reducing AP to tridiagonal form.
144*>
145*> Eigenvalues will be computed most accurately when ABSTOL is
146*> set to twice the underflow threshold 2*SLAMCH('S'), not zero.
147*> If this routine returns with INFO>0, indicating that some
148*> eigenvectors did not converge, try setting ABSTOL to
149*> 2*SLAMCH('S').
150*>
151*> See "Computing Small Singular Values of Bidiagonal Matrices
152*> with Guaranteed High Relative Accuracy," by Demmel and
153*> Kahan, LAPACK Working Note #3.
154*> \endverbatim
155*>
156*> \param[out] M
157*> \verbatim
158*> M is INTEGER
159*> The total number of eigenvalues found. 0 <= M <= N.
160*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
161*> \endverbatim
162*>
163*> \param[out] W
164*> \verbatim
165*> W is REAL array, dimension (N)
166*> If INFO = 0, the selected eigenvalues in ascending order.
167*> \endverbatim
168*>
169*> \param[out] Z
170*> \verbatim
171*> Z is REAL array, dimension (LDZ, max(1,M))
172*> If JOBZ = 'V', then if INFO = 0, the first M columns of Z
173*> contain the orthonormal eigenvectors of the matrix A
174*> corresponding to the selected eigenvalues, with the i-th
175*> column of Z holding the eigenvector associated with W(i).
176*> If an eigenvector fails to converge, then that column of Z
177*> contains the latest approximation to the eigenvector, and the
178*> index of the eigenvector is returned in IFAIL.
179*> If JOBZ = 'N', then Z is not referenced.
180*> Note: the user must ensure that at least max(1,M) columns are
181*> supplied in the array Z; if RANGE = 'V', the exact value of M
182*> is not known in advance and an upper bound must be used.
183*> \endverbatim
184*>
185*> \param[in] LDZ
186*> \verbatim
187*> LDZ is INTEGER
188*> The leading dimension of the array Z. LDZ >= 1, and if
189*> JOBZ = 'V', LDZ >= max(1,N).
190*> \endverbatim
191*>
192*> \param[out] WORK
193*> \verbatim
194*> WORK is REAL array, dimension (8*N)
195*> \endverbatim
196*>
197*> \param[out] IWORK
198*> \verbatim
199*> IWORK is INTEGER array, dimension (5*N)
200*> \endverbatim
201*>
202*> \param[out] IFAIL
203*> \verbatim
204*> IFAIL is INTEGER array, dimension (N)
205*> If JOBZ = 'V', then if INFO = 0, the first M elements of
206*> IFAIL are zero. If INFO > 0, then IFAIL contains the
207*> indices of the eigenvectors that failed to converge.
208*> If JOBZ = 'N', then IFAIL is not referenced.
209*> \endverbatim
210*>
211*> \param[out] INFO
212*> \verbatim
213*> INFO is INTEGER
214*> = 0: successful exit
215*> < 0: if INFO = -i, the i-th argument had an illegal value
216*> > 0: if INFO = i, then i eigenvectors failed to converge.
217*> Their indices are stored in array IFAIL.
218*> \endverbatim
219*
220* Authors:
221* ========
222*
223*> \author Univ. of Tennessee
224*> \author Univ. of California Berkeley
225*> \author Univ. of Colorado Denver
226*> \author NAG Ltd.
227*
228*> \ingroup hpevx
229*
230* =====================================================================
231 SUBROUTINE sspevx( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU,
232 $ ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL,
233 $ INFO )
234*
235* -- LAPACK driver routine --
236* -- LAPACK is a software package provided by Univ. of Tennessee, --
237* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
238*
239* .. Scalar Arguments ..
240 CHARACTER JOBZ, RANGE, UPLO
241 INTEGER IL, INFO, IU, LDZ, M, N
242 REAL ABSTOL, VL, VU
243* ..
244* .. Array Arguments ..
245 INTEGER IFAIL( * ), IWORK( * )
246 REAL AP( * ), W( * ), WORK( * ), Z( LDZ, * )
247* ..
248*
249* =====================================================================
250*
251* .. Parameters ..
252 REAL ZERO, ONE
253 PARAMETER ( ZERO = 0.0e0, one = 1.0e0 )
254* ..
255* .. Local Scalars ..
256 LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
257 CHARACTER ORDER
258 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE,
259 $ indisp, indiwo, indtau, indwrk, iscale, itmp1,
260 $ j, jj, nsplit
261 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
262 $ SIGMA, SMLNUM, TMP1, VLL, VUU
263* ..
264* .. External Functions ..
265 LOGICAL LSAME
266 REAL SLAMCH, SLANSP
267 EXTERNAL lsame, slamch, slansp
268* ..
269* .. External Subroutines ..
270 EXTERNAL scopy, sopgtr, sopmtr, sscal, ssptrd, sstebz,
271 $ sstein, ssteqr, ssterf, sswap, xerbla
272* ..
273* .. Intrinsic Functions ..
274 INTRINSIC max, min, sqrt
275* ..
276* .. Executable Statements ..
277*
278* Test the input parameters.
279*
280 wantz = lsame( jobz, 'V' )
281 alleig = lsame( range, 'A' )
282 valeig = lsame( range, 'V' )
283 indeig = lsame( range, 'I' )
284*
285 info = 0
286 IF( .NOT.( wantz .OR. lsame( jobz, 'N' ) ) ) THEN
287 info = -1
288 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) ) THEN
289 info = -2
290 ELSE IF( .NOT.( lsame( uplo, 'L' ) .OR. lsame( uplo, 'U' ) ) )
291 $ THEN
292 info = -3
293 ELSE IF( n.LT.0 ) THEN
294 info = -4
295 ELSE
296 IF( valeig ) THEN
297 IF( n.GT.0 .AND. vu.LE.vl )
298 $ info = -7
299 ELSE IF( indeig ) THEN
300 IF( il.LT.1 .OR. il.GT.max( 1, n ) ) THEN
301 info = -8
302 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n ) THEN
303 info = -9
304 END IF
305 END IF
306 END IF
307 IF( info.EQ.0 ) THEN
308 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
309 $ info = -14
310 END IF
311*
312 IF( info.NE.0 ) THEN
313 CALL xerbla( 'SSPEVX', -info )
314 RETURN
315 END IF
316*
317* Quick return if possible
318*
319 m = 0
320 IF( n.EQ.0 )
321 $ RETURN
322*
323 IF( n.EQ.1 ) THEN
324 IF( alleig .OR. indeig ) THEN
325 m = 1
326 w( 1 ) = ap( 1 )
327 ELSE
328 IF( vl.LT.ap( 1 ) .AND. vu.GE.ap( 1 ) ) THEN
329 m = 1
330 w( 1 ) = ap( 1 )
331 END IF
332 END IF
333 IF( wantz )
334 $ z( 1, 1 ) = one
335 RETURN
336 END IF
337*
338* Get machine constants.
339*
340 safmin = slamch( 'Safe minimum' )
341 eps = slamch( 'Precision' )
342 smlnum = safmin / eps
343 bignum = one / smlnum
344 rmin = sqrt( smlnum )
345 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
346*
347* Scale matrix to allowable range, if necessary.
348*
349 iscale = 0
350 abstll = abstol
351 IF ( valeig ) THEN
352 vll = vl
353 vuu = vu
354 ELSE
355 vll = zero
356 vuu = zero
357 ENDIF
358 anrm = slansp( 'M', uplo, n, ap, work )
359 IF( anrm.GT.zero .AND. anrm.LT.rmin ) THEN
360 iscale = 1
361 sigma = rmin / anrm
362 ELSE IF( anrm.GT.rmax ) THEN
363 iscale = 1
364 sigma = rmax / anrm
365 END IF
366 IF( iscale.EQ.1 ) THEN
367 CALL sscal( ( n*( n+1 ) ) / 2, sigma, ap, 1 )
368 IF( abstol.GT.0 )
369 $ abstll = abstol*sigma
370 IF( valeig ) THEN
371 vll = vl*sigma
372 vuu = vu*sigma
373 END IF
374 END IF
375*
376* Call SSPTRD to reduce symmetric packed matrix to tridiagonal form.
377*
378 indtau = 1
379 inde = indtau + n
380 indd = inde + n
381 indwrk = indd + n
382 CALL ssptrd( uplo, n, ap, work( indd ), work( inde ),
383 $ work( indtau ), iinfo )
384*
385* If all eigenvalues are desired and ABSTOL is less than or equal
386* to zero, then call SSTERF or SOPGTR and SSTEQR. If this fails
387* for some eigenvalue, then try SSTEBZ.
388*
389 test = .false.
390 IF (indeig) THEN
391 IF (il.EQ.1 .AND. iu.EQ.n) THEN
392 test = .true.
393 END IF
394 END IF
395 IF ((alleig .OR. test) .AND. (abstol.LE.zero)) THEN
396 CALL scopy( n, work( indd ), 1, w, 1 )
397 indee = indwrk + 2*n
398 IF( .NOT.wantz ) THEN
399 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
400 CALL ssterf( n, w, work( indee ), info )
401 ELSE
402 CALL sopgtr( uplo, n, ap, work( indtau ), z, ldz,
403 $ work( indwrk ), iinfo )
404 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
405 CALL ssteqr( jobz, n, w, work( indee ), z, ldz,
406 $ work( indwrk ), info )
407 IF( info.EQ.0 ) THEN
408 DO 10 i = 1, n
409 ifail( i ) = 0
410 10 CONTINUE
411 END IF
412 END IF
413 IF( info.EQ.0 ) THEN
414 m = n
415 GO TO 20
416 END IF
417 info = 0
418 END IF
419*
420* Otherwise, call SSTEBZ and, if eigenvectors are desired, SSTEIN.
421*
422 IF( wantz ) THEN
423 order = 'B'
424 ELSE
425 order = 'E'
426 END IF
427 indisp = 1 + n
428 indiwo = indisp + n
429 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
430 $ work( indd ), work( inde ), m, nsplit, w,
431 $ iwork( 1 ), iwork( indisp ), work( indwrk ),
432 $ iwork( indiwo ), info )
433*
434 IF( wantz ) THEN
435 CALL sstein( n, work( indd ), work( inde ), m, w,
436 $ iwork( 1 ), iwork( indisp ), z, ldz,
437 $ work( indwrk ), iwork( indiwo ), ifail, info )
438*
439* Apply orthogonal matrix used in reduction to tridiagonal
440* form to eigenvectors returned by SSTEIN.
441*
442 CALL sopmtr( 'L', uplo, 'N', n, m, ap, work( indtau ), z, ldz,
443 $ work( indwrk ), iinfo )
444 END IF
445*
446* If matrix was scaled, then rescale eigenvalues appropriately.
447*
448 20 CONTINUE
449 IF( iscale.EQ.1 ) THEN
450 IF( info.EQ.0 ) THEN
451 imax = m
452 ELSE
453 imax = info - 1
454 END IF
455 CALL sscal( imax, one / sigma, w, 1 )
456 END IF
457*
458* If eigenvalues are not in order, then sort them, along with
459* eigenvectors.
460*
461 IF( wantz ) THEN
462 DO 40 j = 1, m - 1
463 i = 0
464 tmp1 = w( j )
465 DO 30 jj = j + 1, m
466 IF( w( jj ).LT.tmp1 ) THEN
467 i = jj
468 tmp1 = w( jj )
469 END IF
470 30 CONTINUE
471*
472 IF( i.NE.0 ) THEN
473 itmp1 = iwork( 1 + i-1 )
474 w( i ) = w( j )
475 iwork( 1 + i-1 ) = iwork( 1 + j-1 )
476 w( j ) = tmp1
477 iwork( 1 + j-1 ) = itmp1
478 CALL sswap( n, z( 1, i ), 1, z( 1, j ), 1 )
479 IF( info.NE.0 ) THEN
480 itmp1 = ifail( i )
481 ifail( i ) = ifail( j )
482 ifail( j ) = itmp1
483 END IF
484 END IF
485 40 CONTINUE
486 END IF
487*
488 RETURN
489*
490* End of SSPEVX
491*
492 END
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
scopy
subroutine scopy(n, sx, incx, sy, incy)
SCOPY
Definition scopy.f:82
sspevx
subroutine sspevx(jobz, range, uplo, n, ap, vl, vu, il, iu, abstol, m, w, z, ldz, work, iwork, ifail, info)
SSPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
Definition sspevx.f:234
ssptrd
subroutine ssptrd(uplo, n, ap, d, e, tau, info)
SSPTRD
Definition ssptrd.f:150
sscal
subroutine sscal(n, sa, sx, incx)
SSCAL
Definition sscal.f:79
sstebz
subroutine sstebz(range, order, n, vl, vu, il, iu, abstol, d, e, m, nsplit, w, iblock, isplit, work, iwork, info)
SSTEBZ
Definition sstebz.f:273
sstein
subroutine sstein(n, d, e, m, w, iblock, isplit, z, ldz, work, iwork, ifail, info)
SSTEIN
Definition sstein.f:174
ssteqr
subroutine ssteqr(compz, n, d, e, z, ldz, work, info)
SSTEQR
Definition ssteqr.f:131
ssterf
subroutine ssterf(n, d, e, info)
SSTERF
Definition ssterf.f:86
sswap
subroutine sswap(n, sx, incx, sy, incy)
SSWAP
Definition sswap.f:82
sopgtr
subroutine sopgtr(uplo, n, ap, tau, q, ldq, work, info)
SOPGTR
Definition sopgtr.f:114
sopmtr
subroutine sopmtr(side, uplo, trans, m, n, ap, tau, c, ldc, work, info)
SOPMTR
Definition sopmtr.f:150