LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
chbgvx.f
Go to the documentation of this file.
1*> \brief \b CHBGVX
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CHBGVX + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chbgvx.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chbgvx.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chbgvx.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE CHBGVX( JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB,
22* LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z,
23* LDZ, WORK, RWORK, IWORK, IFAIL, INFO )
24*
25* .. Scalar Arguments ..
26* CHARACTER JOBZ, RANGE, UPLO
27* INTEGER IL, INFO, IU, KA, KB, LDAB, LDBB, LDQ, LDZ, M,
28* $ N
29* REAL ABSTOL, VL, VU
30* ..
31* .. Array Arguments ..
32* INTEGER IFAIL( * ), IWORK( * )
33* REAL RWORK( * ), W( * )
34* COMPLEX AB( LDAB, * ), BB( LDBB, * ), Q( LDQ, * ),
35* $ WORK( * ), Z( LDZ, * )
36* ..
37*
38*
39*> \par Purpose:
40* =============
41*>
42*> \verbatim
43*>
44*> CHBGVX computes all the eigenvalues, and optionally, the eigenvectors
45*> of a complex generalized Hermitian-definite banded eigenproblem, of
46*> the form A*x=(lambda)*B*x. Here A and B are assumed to be Hermitian
47*> and banded, and B is also positive definite. Eigenvalues and
48*> eigenvectors can be selected by specifying either all eigenvalues,
49*> a range of values or a range of indices for the desired eigenvalues.
50*> \endverbatim
51*
52* Arguments:
53* ==========
54*
55*> \param[in] JOBZ
56*> \verbatim
57*> JOBZ is CHARACTER*1
58*> = 'N': Compute eigenvalues only;
59*> = 'V': Compute eigenvalues and eigenvectors.
60*> \endverbatim
61*>
62*> \param[in] RANGE
63*> \verbatim
64*> RANGE is CHARACTER*1
65*> = 'A': all eigenvalues will be found;
66*> = 'V': all eigenvalues in the half-open interval (VL,VU]
67*> will be found;
68*> = 'I': the IL-th through IU-th eigenvalues will be found.
69*> \endverbatim
70*>
71*> \param[in] UPLO
72*> \verbatim
73*> UPLO is CHARACTER*1
74*> = 'U': Upper triangles of A and B are stored;
75*> = 'L': Lower triangles of A and B are stored.
76*> \endverbatim
77*>
78*> \param[in] N
79*> \verbatim
80*> N is INTEGER
81*> The order of the matrices A and B. N >= 0.
82*> \endverbatim
83*>
84*> \param[in] KA
85*> \verbatim
86*> KA is INTEGER
87*> The number of superdiagonals of the matrix A if UPLO = 'U',
88*> or the number of subdiagonals if UPLO = 'L'. KA >= 0.
89*> \endverbatim
90*>
91*> \param[in] KB
92*> \verbatim
93*> KB is INTEGER
94*> The number of superdiagonals of the matrix B if UPLO = 'U',
95*> or the number of subdiagonals if UPLO = 'L'. KB >= 0.
96*> \endverbatim
97*>
98*> \param[in,out] AB
99*> \verbatim
100*> AB is COMPLEX array, dimension (LDAB, N)
101*> On entry, the upper or lower triangle of the Hermitian band
102*> matrix A, stored in the first ka+1 rows of the array. The
103*> j-th column of A is stored in the j-th column of the array AB
104*> as follows:
105*> if UPLO = 'U', AB(ka+1+i-j,j) = A(i,j) for max(1,j-ka)<=i<=j;
106*> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+ka).
107*>
108*> On exit, the contents of AB are destroyed.
109*> \endverbatim
110*>
111*> \param[in] LDAB
112*> \verbatim
113*> LDAB is INTEGER
114*> The leading dimension of the array AB. LDAB >= KA+1.
115*> \endverbatim
116*>
117*> \param[in,out] BB
118*> \verbatim
119*> BB is COMPLEX array, dimension (LDBB, N)
120*> On entry, the upper or lower triangle of the Hermitian band
121*> matrix B, stored in the first kb+1 rows of the array. The
122*> j-th column of B is stored in the j-th column of the array BB
123*> as follows:
124*> if UPLO = 'U', BB(kb+1+i-j,j) = B(i,j) for max(1,j-kb)<=i<=j;
125*> if UPLO = 'L', BB(1+i-j,j) = B(i,j) for j<=i<=min(n,j+kb).
126*>
127*> On exit, the factor S from the split Cholesky factorization
128*> B = S**H*S, as returned by CPBSTF.
129*> \endverbatim
130*>
131*> \param[in] LDBB
132*> \verbatim
133*> LDBB is INTEGER
134*> The leading dimension of the array BB. LDBB >= KB+1.
135*> \endverbatim
136*>
137*> \param[out] Q
138*> \verbatim
139*> Q is COMPLEX array, dimension (LDQ, N)
140*> If JOBZ = 'V', the n-by-n matrix used in the reduction of
141*> A*x = (lambda)*B*x to standard form, i.e. C*x = (lambda)*x,
142*> and consequently C to tridiagonal form.
143*> If JOBZ = 'N', the array Q is not referenced.
144*> \endverbatim
145*>
146*> \param[in] LDQ
147*> \verbatim
148*> LDQ is INTEGER
149*> The leading dimension of the array Q. If JOBZ = 'N',
150*> LDQ >= 1. If JOBZ = 'V', LDQ >= max(1,N).
151*> \endverbatim
152*>
153*> \param[in] VL
154*> \verbatim
155*> VL is REAL
156*>
157*> If RANGE='V', the lower bound of the interval to
158*> be searched for eigenvalues. VL < VU.
159*> Not referenced if RANGE = 'A' or 'I'.
160*> \endverbatim
161*>
162*> \param[in] VU
163*> \verbatim
164*> VU is REAL
165*>
166*> If RANGE='V', the upper bound of the interval to
167*> be searched for eigenvalues. VL < VU.
168*> Not referenced if RANGE = 'A' or 'I'.
169*> \endverbatim
170*>
171*> \param[in] IL
172*> \verbatim
173*> IL is INTEGER
174*>
175*> If RANGE='I', the index of the
176*> smallest eigenvalue to be returned.
177*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
178*> Not referenced if RANGE = 'A' or 'V'.
179*> \endverbatim
180*>
181*> \param[in] IU
182*> \verbatim
183*> IU is INTEGER
184*>
185*> If RANGE='I', the index of the
186*> largest eigenvalue to be returned.
187*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0.
188*> Not referenced if RANGE = 'A' or 'V'.
189*> \endverbatim
190*>
191*> \param[in] ABSTOL
192*> \verbatim
193*> ABSTOL is REAL
194*> The absolute error tolerance for the eigenvalues.
195*> An approximate eigenvalue is accepted as converged
196*> when it is determined to lie in an interval [a,b]
197*> of width less than or equal to
198*>
199*> ABSTOL + EPS * max( |a|,|b| ) ,
200*>
201*> where EPS is the machine precision. If ABSTOL is less than
202*> or equal to zero, then EPS*|T| will be used in its place,
203*> where |T| is the 1-norm of the tridiagonal matrix obtained
204*> by reducing AP to tridiagonal form.
205*>
206*> Eigenvalues will be computed most accurately when ABSTOL is
207*> set to twice the underflow threshold 2*SLAMCH('S'), not zero.
208*> If this routine returns with INFO>0, indicating that some
209*> eigenvectors did not converge, try setting ABSTOL to
210*> 2*SLAMCH('S').
211*> \endverbatim
212*>
213*> \param[out] M
214*> \verbatim
215*> M is INTEGER
216*> The total number of eigenvalues found. 0 <= M <= N.
217*> If RANGE = 'A', M = N, and if RANGE = 'I', M = IU-IL+1.
218*> \endverbatim
219*>
220*> \param[out] W
221*> \verbatim
222*> W is REAL array, dimension (N)
223*> If INFO = 0, the eigenvalues in ascending order.
224*> \endverbatim
225*>
226*> \param[out] Z
227*> \verbatim
228*> Z is COMPLEX array, dimension (LDZ, N)
229*> If JOBZ = 'V', then if INFO = 0, Z contains the matrix Z of
230*> eigenvectors, with the i-th column of Z holding the
231*> eigenvector associated with W(i). The eigenvectors are
232*> normalized so that Z**H*B*Z = I.
233*> If JOBZ = 'N', then Z is not referenced.
234*> \endverbatim
235*>
236*> \param[in] LDZ
237*> \verbatim
238*> LDZ is INTEGER
239*> The leading dimension of the array Z. LDZ >= 1, and if
240*> JOBZ = 'V', LDZ >= N.
241*> \endverbatim
242*>
243*> \param[out] WORK
244*> \verbatim
245*> WORK is COMPLEX array, dimension (N)
246*> \endverbatim
247*>
248*> \param[out] RWORK
249*> \verbatim
250*> RWORK is REAL array, dimension (7*N)
251*> \endverbatim
252*>
253*> \param[out] IWORK
254*> \verbatim
255*> IWORK is INTEGER array, dimension (5*N)
256*> \endverbatim
257*>
258*> \param[out] IFAIL
259*> \verbatim
260*> IFAIL is INTEGER array, dimension (N)
261*> If JOBZ = 'V', then if INFO = 0, the first M elements of
262*> IFAIL are zero. If INFO > 0, then IFAIL contains the
263*> indices of the eigenvectors that failed to converge.
264*> If JOBZ = 'N', then IFAIL is not referenced.
265*> \endverbatim
266*>
267*> \param[out] INFO
268*> \verbatim
269*> INFO is INTEGER
270*> = 0: successful exit
271*> < 0: if INFO = -i, the i-th argument had an illegal value
272*> > 0: if INFO = i, and i is:
273*> <= N: then i eigenvectors failed to converge. Their
274*> indices are stored in array IFAIL.
275*> > N: if INFO = N + i, for 1 <= i <= N, then CPBSTF
276*> returned INFO = i: B is not positive definite.
277*> The factorization of B could not be completed and
278*> no eigenvalues or eigenvectors were computed.
279*> \endverbatim
280*
281* Authors:
282* ========
283*
284*> \author Univ. of Tennessee
285*> \author Univ. of California Berkeley
286*> \author Univ. of Colorado Denver
287*> \author NAG Ltd.
288*
289*> \ingroup complexOTHEReigen
290*
291*> \par Contributors:
292* ==================
293*>
294*> Mark Fahey, Department of Mathematics, Univ. of Kentucky, USA
295*
296* =====================================================================
297 SUBROUTINE chbgvx( JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB,
298 $ LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z,
299 $ LDZ, WORK, RWORK, IWORK, IFAIL, INFO )
300*
301* -- LAPACK driver routine --
302* -- LAPACK is a software package provided by Univ. of Tennessee, --
303* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
304*
305* .. Scalar Arguments ..
306 CHARACTER JOBZ, RANGE, UPLO
307 INTEGER IL, INFO, IU, KA, KB, LDAB, LDBB, LDQ, LDZ, M,
308 $ n
309 REAL ABSTOL, VL, VU
310* ..
311* .. Array Arguments ..
312 INTEGER IFAIL( * ), IWORK( * )
313 REAL RWORK( * ), W( * )
314 COMPLEX AB( LDAB, * ), BB( LDBB, * ), Q( LDQ, * ),
315 $ work( * ), z( ldz, * )
316* ..
317*
318* =====================================================================
319*
320* .. Parameters ..
321 REAL ZERO
322 PARAMETER ( ZERO = 0.0e+0 )
323 COMPLEX CZERO, CONE
324 parameter( czero = ( 0.0e+0, 0.0e+0 ),
325 $ cone = ( 1.0e+0, 0.0e+0 ) )
326* ..
327* .. Local Scalars ..
328 LOGICAL ALLEIG, INDEIG, TEST, UPPER, VALEIG, WANTZ
329 CHARACTER ORDER, VECT
330 INTEGER I, IINFO, INDD, INDE, INDEE, INDIBL, INDISP,
331 $ indiwk, indrwk, indwrk, itmp1, j, jj, nsplit
332 REAL TMP1
333* ..
334* .. External Functions ..
335 LOGICAL LSAME
336 EXTERNAL LSAME
337* ..
338* .. External Subroutines ..
339 EXTERNAL ccopy, cgemv, chbgst, chbtrd, clacpy, cpbstf,
341 $ xerbla
342* ..
343* .. Intrinsic Functions ..
344 INTRINSIC min
345* ..
346* .. Executable Statements ..
347*
348* Test the input parameters.
349*
350 wantz = lsame( jobz, 'V' )
351 upper = lsame( uplo, 'U' )
352 alleig = lsame( range, 'A' )
353 valeig = lsame( range, 'V' )
354 indeig = lsame( range, 'I' )
355*
356 info = 0
357 IF( .NOT.( wantz .OR. lsame( jobz, 'N' ) ) ) THEN
358 info = -1
359 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) ) THEN
360 info = -2
361 ELSE IF( .NOT.( upper .OR. lsame( uplo, 'L' ) ) ) THEN
362 info = -3
363 ELSE IF( n.LT.0 ) THEN
364 info = -4
365 ELSE IF( ka.LT.0 ) THEN
366 info = -5
367 ELSE IF( kb.LT.0 .OR. kb.GT.ka ) THEN
368 info = -6
369 ELSE IF( ldab.LT.ka+1 ) THEN
370 info = -8
371 ELSE IF( ldbb.LT.kb+1 ) THEN
372 info = -10
373 ELSE IF( ldq.LT.1 .OR. ( wantz .AND. ldq.LT.n ) ) THEN
374 info = -12
375 ELSE
376 IF( valeig ) THEN
377 IF( n.GT.0 .AND. vu.LE.vl )
378 $ info = -14
379 ELSE IF( indeig ) THEN
380 IF( il.LT.1 .OR. il.GT.max( 1, n ) ) THEN
381 info = -15
382 ELSE IF ( iu.LT.min( n, il ) .OR. iu.GT.n ) THEN
383 info = -16
384 END IF
385 END IF
386 END IF
387 IF( info.EQ.0) THEN
388 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) ) THEN
389 info = -21
390 END IF
391 END IF
392*
393 IF( info.NE.0 ) THEN
394 CALL xerbla( 'CHBGVX', -info )
395 RETURN
396 END IF
397*
398* Quick return if possible
399*
400 m = 0
401 IF( n.EQ.0 )
402 $ RETURN
403*
404* Form a split Cholesky factorization of B.
405*
406 CALL cpbstf( uplo, n, kb, bb, ldbb, info )
407 IF( info.NE.0 ) THEN
408 info = n + info
409 RETURN
410 END IF
411*
412* Transform problem to standard eigenvalue problem.
413*
414 CALL chbgst( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, q, ldq,
415 $ work, rwork, iinfo )
416*
417* Solve the standard eigenvalue problem.
418* Reduce Hermitian band matrix to tridiagonal form.
419*
420 indd = 1
421 inde = indd + n
422 indrwk = inde + n
423 indwrk = 1
424 IF( wantz ) THEN
425 vect = 'U'
426 ELSE
427 vect = 'N'
428 END IF
429 CALL chbtrd( vect, uplo, n, ka, ab, ldab, rwork( indd ),
430 $ rwork( inde ), q, ldq, work( indwrk ), iinfo )
431*
432* If all eigenvalues are desired and ABSTOL is less than or equal
433* to zero, then call SSTERF or CSTEQR. If this fails for some
434* eigenvalue, then try SSTEBZ.
435*
436 test = .false.
437 IF( indeig ) THEN
438 IF( il.EQ.1 .AND. iu.EQ.n ) THEN
439 test = .true.
440 END IF
441 END IF
442 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) ) THEN
443 CALL scopy( n, rwork( indd ), 1, w, 1 )
444 indee = indrwk + 2*n
445 CALL scopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
446 IF( .NOT.wantz ) THEN
447 CALL ssterf( n, w, rwork( indee ), info )
448 ELSE
449 CALL clacpy( 'A', n, n, q, ldq, z, ldz )
450 CALL csteqr( jobz, n, w, rwork( indee ), z, ldz,
451 $ rwork( indrwk ), info )
452 IF( info.EQ.0 ) THEN
453 DO 10 i = 1, n
454 ifail( i ) = 0
455 10 CONTINUE
456 END IF
457 END IF
458 IF( info.EQ.0 ) THEN
459 m = n
460 GO TO 30
461 END IF
462 info = 0
463 END IF
464*
465* Otherwise, call SSTEBZ and, if eigenvectors are desired,
466* call CSTEIN.
467*
468 IF( wantz ) THEN
469 order = 'B'
470 ELSE
471 order = 'E'
472 END IF
473 indibl = 1
474 indisp = indibl + n
475 indiwk = indisp + n
476 CALL sstebz( range, order, n, vl, vu, il, iu, abstol,
477 $ rwork( indd ), rwork( inde ), m, nsplit, w,
478 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
479 $ iwork( indiwk ), info )
480*
481 IF( wantz ) THEN
482 CALL cstein( n, rwork( indd ), rwork( inde ), m, w,
483 $ iwork( indibl ), iwork( indisp ), z, ldz,
484 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
485*
486* Apply unitary matrix used in reduction to tridiagonal
487* form to eigenvectors returned by CSTEIN.
488*
489 DO 20 j = 1, m
490 CALL ccopy( n, z( 1, j ), 1, work( 1 ), 1 )
491 CALL cgemv( 'N', n, n, cone, q, ldq, work, 1, czero,
492 $ z( 1, j ), 1 )
493 20 CONTINUE
494 END IF
495*
496 30 CONTINUE
497*
498* If eigenvalues are not in order, then sort them, along with
499* eigenvectors.
500*
501 IF( wantz ) THEN
502 DO 50 j = 1, m - 1
503 i = 0
504 tmp1 = w( j )
505 DO 40 jj = j + 1, m
506 IF( w( jj ).LT.tmp1 ) THEN
507 i = jj
508 tmp1 = w( jj )
509 END IF
510 40 CONTINUE
511*
512 IF( i.NE.0 ) THEN
513 itmp1 = iwork( indibl+i-1 )
514 w( i ) = w( j )
515 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
516 w( j ) = tmp1
517 iwork( indibl+j-1 ) = itmp1
518 CALL cswap( n, z( 1, i ), 1, z( 1, j ), 1 )
519 IF( info.NE.0 ) THEN
520 itmp1 = ifail( i )
521 ifail( i ) = ifail( j )
522 ifail( j ) = itmp1
523 END IF
524 END IF
525 50 CONTINUE
526 END IF
527*
528 RETURN
529*
530* End of CHBGVX
531*
532 END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine ssterf(N, D, E, INFO)
SSTERF
Definition: ssterf.f:86
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
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
Definition: ccopy.f:81
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
Definition: cswap.f:81
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
Definition: cgemv.f:158
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:103
subroutine cstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
CSTEIN
Definition: cstein.f:182
subroutine cpbstf(UPLO, N, KD, AB, LDAB, INFO)
CPBSTF
Definition: cpbstf.f:153
subroutine chbtrd(VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, WORK, INFO)
CHBTRD
Definition: chbtrd.f:163
subroutine chbgst(VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, LDX, WORK, RWORK, INFO)
CHBGST
Definition: chbgst.f:165
subroutine csteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
CSTEQR
Definition: csteqr.f:132
subroutine chbgvx(JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, IWORK, IFAIL, INFO)
CHBGVX
Definition: chbgvx.f:300
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
Definition: scopy.f:82