Skip to content

Commit b227de9

Browse files
authored
Merge pull request #5701 from martin-frbg/lapack1204
Fix internal errors getting ignored in calculation of selected eigenvalues (Reference-LAPACK PR 1204)
2 parents 51e904d + 1b6fc34 commit b227de9

26 files changed

+378
-124
lines changed

lapack-netlib/SRC/chbevx.f

Lines changed: 14 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -246,8 +246,11 @@
246246
*> INFO is INTEGER
247247
*> = 0: successful exit
248248
*> < 0: if INFO = -i, the i-th argument had an illegal value
249-
*> > 0: if INFO = i, then i eigenvectors failed to converge.
250-
*> Their indices are stored in array IFAIL.
249+
*> > 0: if INFO = i, and i is:
250+
*> <= N: then i eigenvectors failed to converge in
251+
*> CSTEIN; their indices are stored in IFAIL.
252+
*> > N: SSTEBZ returned INFO = INFO - N;
253+
*> see SSTEBZ for details.
251254
*> \endverbatim
252255
*
253256
* Authors:
@@ -484,12 +487,19 @@ SUBROUTINE CHBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL,
484487
CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
485488
$ RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W,
486489
$ IWORK( INDIBL ), IWORK( INDISP ), RWORK( INDRWK ),
487-
$ IWORK( INDIWK ), INFO )
490+
$ IWORK( INDIWK ), IINFO )
491+
IF( IINFO.NE.0 ) THEN
492+
INFO = N + IINFO
493+
IF( IINFO.NE.1 )
494+
$ GO TO 30
495+
END IF
488496
*
489497
IF( WANTZ ) THEN
490498
CALL CSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W,
491499
$ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
492-
$ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO )
500+
$ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, IINFO )
501+
IF( IINFO.NE.0 .AND. INFO.EQ.0 )
502+
$ INFO = IINFO
493503
*
494504
* Apply unitary matrix used in reduction to tridiagonal
495505
* form to eigenvectors returned by CSTEIN.

lapack-netlib/SRC/chbevx_2stage.f

Lines changed: 14 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -273,8 +273,11 @@
273273
*> INFO is INTEGER
274274
*> = 0: successful exit
275275
*> < 0: if INFO = -i, the i-th argument had an illegal value
276-
*> > 0: if INFO = i, then i eigenvectors failed to converge.
277-
*> Their indices are stored in array IFAIL.
276+
*> > 0: if INFO = i, and i is:
277+
*> <= N: then i eigenvectors failed to converge in
278+
*> CSTEIN; their indices are stored in IFAIL.
279+
*> > N: SSTEBZ returned INFO = INFO - N;
280+
*> see SSTEBZ for details.
278281
*> \endverbatim
279282
*
280283
* Authors:
@@ -577,12 +580,19 @@ SUBROUTINE CHBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB,
577580
CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
578581
$ RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W,
579582
$ IWORK( INDIBL ), IWORK( INDISP ), RWORK( INDRWK ),
580-
$ IWORK( INDIWK ), INFO )
583+
$ IWORK( INDIWK ), IINFO )
584+
IF( IINFO.NE.0 ) THEN
585+
INFO = N + IINFO
586+
IF( IINFO.NE.1 )
587+
$ GO TO 30
588+
END IF
581589
*
582590
IF( WANTZ ) THEN
583591
CALL CSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W,
584592
$ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
585-
$ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO )
593+
$ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, IINFO )
594+
IF( IINFO.NE.0 .AND. INFO.EQ.0 )
595+
$ INFO = IINFO
586596
*
587597
* Apply unitary matrix used in reduction to tridiagonal
588598
* form to eigenvectors returned by CSTEIN.

lapack-netlib/SRC/chbgvx.f

Lines changed: 17 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -270,12 +270,14 @@
270270
*> = 0: successful exit
271271
*> < 0: if INFO = -i, the i-th argument had an illegal value
272272
*> > 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.
273+
*> <= N: then i eigenvectors failed to converge in
274+
*> CSTEIN; their indices are stored in IFAIL.
275+
*> N+1..2N: 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
278+
*> and no eigenvalues or eigenvectors were computed.
279+
*> > 2N: if INFO = 2*N + i, then SSTEBZ returned
280+
*> INFO = i; see SSTEBZ for details.
279281
*> \endverbatim
280282
*
281283
* Authors:
@@ -475,12 +477,19 @@ SUBROUTINE CHBGVX( JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB,
475477
CALL SSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL,
476478
$ RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W,
477479
$ IWORK( 1 ), IWORK( INDISP ), RWORK( INDRWK ),
478-
$ IWORK( INDIWK ), INFO )
480+
$ IWORK( INDIWK ), IINFO )
481+
IF( IINFO.NE.0 ) THEN
482+
INFO = 2*N + IINFO
483+
IF( IINFO.NE.1 )
484+
$ GO TO 30
485+
END IF
479486
*
480487
IF( WANTZ ) THEN
481488
CALL CSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W,
482489
$ IWORK( 1 ), IWORK( INDISP ), Z, LDZ,
483-
$ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO )
490+
$ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, IINFO )
491+
IF( IINFO.NE.0 .AND. INFO.EQ.0 )
492+
$ INFO = IINFO
484493
*
485494
* Apply unitary matrix used in reduction to tridiagonal
486495
* form to eigenvectors returned by CSTEIN.

lapack-netlib/SRC/cheevx.f

Lines changed: 14 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -238,8 +238,11 @@
238238
*> INFO is INTEGER
239239
*> = 0: successful exit
240240
*> < 0: if INFO = -i, the i-th argument had an illegal value
241-
*> > 0: if INFO = i, then i eigenvectors failed to converge.
242-
*> Their indices are stored in array IFAIL.
241+
*> > 0: if INFO = i, and i is:
242+
*> <= N: then i eigenvectors failed to converge in
243+
*> CSTEIN; their indices are stored in IFAIL.
244+
*> > N: SSTEBZ returned INFO = INFO - N;
245+
*> see SSTEBZ for details.
243246
*> \endverbatim
244247
*
245248
* Authors:
@@ -494,12 +497,19 @@ SUBROUTINE CHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
494497
CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
495498
$ RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W,
496499
$ IWORK( INDIBL ), IWORK( INDISP ), RWORK( INDRWK ),
497-
$ IWORK( INDIWK ), INFO )
500+
$ IWORK( INDIWK ), IINFO )
501+
IF( IINFO.NE.0 ) THEN
502+
INFO = N + IINFO
503+
IF( IINFO.NE.1 )
504+
$ GO TO 40
505+
END IF
498506
*
499507
IF( WANTZ ) THEN
500508
CALL CSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W,
501509
$ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
502-
$ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO )
510+
$ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, IINFO )
511+
IF( IINFO.NE.0 .AND. INFO.EQ.0 )
512+
$ INFO = IINFO
503513
*
504514
* Apply unitary matrix used in reduction to tridiagonal
505515
* form to eigenvectors returned by CSTEIN.

lapack-netlib/SRC/cheevx_2stage.f

Lines changed: 14 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -253,8 +253,11 @@
253253
*> INFO is INTEGER
254254
*> = 0: successful exit
255255
*> < 0: if INFO = -i, the i-th argument had an illegal value
256-
*> > 0: if INFO = i, then i eigenvectors failed to converge.
257-
*> Their indices are stored in array IFAIL.
256+
*> > 0: if INFO = i, and i is:
257+
*> <= N: then i eigenvectors failed to converge in
258+
*> CSTEIN; their indices are stored in IFAIL.
259+
*> > N: SSTEBZ returned INFO = INFO - N;
260+
*> see SSTEBZ for details.
258261
*> \endverbatim
259262
*
260263
* Authors:
@@ -553,12 +556,19 @@ SUBROUTINE CHEEVX_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
553556
CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
554557
$ RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W,
555558
$ IWORK( INDIBL ), IWORK( INDISP ), RWORK( INDRWK ),
556-
$ IWORK( INDIWK ), INFO )
559+
$ IWORK( INDIWK ), IINFO )
560+
IF( IINFO.NE.0 ) THEN
561+
INFO = N + IINFO
562+
IF( IINFO.NE.1 )
563+
$ GO TO 40
564+
END IF
557565
*
558566
IF( WANTZ ) THEN
559567
CALL CSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W,
560568
$ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
561-
$ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO )
569+
$ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, IINFO )
570+
IF( IINFO.NE.0 .AND. INFO.EQ.0 )
571+
$ INFO = IINFO
562572
*
563573
* Apply unitary matrix used in reduction to tridiagonal
564574
* form to eigenvectors returned by CSTEIN.

lapack-netlib/SRC/chpevx.f

Lines changed: 14 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -219,8 +219,11 @@
219219
*> INFO is INTEGER
220220
*> = 0: successful exit
221221
*> < 0: if INFO = -i, the i-th argument had an illegal value
222-
*> > 0: if INFO = i, then i eigenvectors failed to converge.
223-
*> Their indices are stored in array IFAIL.
222+
*> > 0: if INFO = i, and i is:
223+
*> <= N: then i eigenvectors failed to converge in
224+
*> CSTEIN; their indices are stored in IFAIL.
225+
*> > N: SSTEBZ returned INFO = INFO - N;
226+
*> see SSTEBZ for details.
224227
*> \endverbatim
225228
*
226229
* Authors:
@@ -439,12 +442,19 @@ SUBROUTINE CHPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU,
439442
CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
440443
$ RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W,
441444
$ IWORK( 1 ), IWORK( INDISP ), RWORK( INDRWK ),
442-
$ IWORK( INDIWK ), INFO )
445+
$ IWORK( INDIWK ), IINFO )
446+
IF( IINFO.NE.0 ) THEN
447+
INFO = N + IINFO
448+
IF( IINFO.NE.1 )
449+
$ GO TO 20
450+
END IF
443451
*
444452
IF( WANTZ ) THEN
445453
CALL CSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W,
446454
$ IWORK( 1 ), IWORK( INDISP ), Z, LDZ,
447-
$ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO )
455+
$ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, IINFO )
456+
IF( IINFO.NE.0 .AND. INFO.EQ.0 )
457+
$ INFO = IINFO
448458
*
449459
* Apply unitary matrix used in reduction to tridiagonal
450460
* form to eigenvectors returned by CSTEIN.

lapack-netlib/SRC/dsbevx.f

Lines changed: 14 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -244,8 +244,11 @@
244244
*> INFO is INTEGER
245245
*> = 0: successful exit.
246246
*> < 0: if INFO = -i, the i-th argument had an illegal value.
247-
*> > 0: if INFO = i, then i eigenvectors failed to converge.
248-
*> Their indices are stored in array IFAIL.
247+
*> > 0: if INFO = i, and i is:
248+
*> <= N: then i eigenvectors failed to converge in
249+
*> DSTEIN; their indices are stored in IFAIL.
250+
*> > N: DSTEBZ returned INFO = INFO - N;
251+
*> see DSTEBZ for details.
249252
*> \endverbatim
250253
*
251254
* Authors:
@@ -474,12 +477,19 @@ SUBROUTINE DSBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL,
474477
CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
475478
$ WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
476479
$ IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWRK ),
477-
$ IWORK( INDIWO ), INFO )
480+
$ IWORK( INDIWO ), IINFO )
481+
IF( IINFO.NE.0 ) THEN
482+
INFO = N + IINFO
483+
IF( IINFO.NE.1 )
484+
$ GO TO 30
485+
END IF
478486
*
479487
IF( WANTZ ) THEN
480488
CALL DSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
481489
$ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
482-
$ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
490+
$ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, IINFO )
491+
IF( IINFO.NE.0 .AND. INFO.EQ.0 )
492+
$ INFO = IINFO
483493
*
484494
* Apply orthogonal matrix used in reduction to tridiagonal
485495
* form to eigenvectors returned by DSTEIN.

lapack-netlib/SRC/dsbevx_2stage.f

Lines changed: 14 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -269,8 +269,11 @@
269269
*> INFO is INTEGER
270270
*> = 0: successful exit.
271271
*> < 0: if INFO = -i, the i-th argument had an illegal value.
272-
*> > 0: if INFO = i, then i eigenvectors failed to converge.
273-
*> Their indices are stored in array IFAIL.
272+
*> > 0: if INFO = i, and i is:
273+
*> <= N: then i eigenvectors failed to converge in
274+
*> DSTEIN; their indices are stored in IFAIL.
275+
*> > N: DSTEBZ returned INFO = INFO - N;
276+
*> see DSTEBZ for details.
274277
*> \endverbatim
275278
*
276279
* Authors:
@@ -563,12 +566,19 @@ SUBROUTINE DSBEVX_2STAGE( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q,
563566
CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
564567
$ WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
565568
$ IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWRK ),
566-
$ IWORK( INDIWO ), INFO )
569+
$ IWORK( INDIWO ), IINFO )
570+
IF( IINFO.NE.0 ) THEN
571+
INFO = N + IINFO
572+
IF( IINFO.NE.1 )
573+
$ GO TO 30
574+
END IF
567575
*
568576
IF( WANTZ ) THEN
569577
CALL DSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
570578
$ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
571-
$ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
579+
$ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, IINFO )
580+
IF( IINFO.NE.0 .AND. INFO.EQ.0 )
581+
$ INFO = IINFO
572582
*
573583
* Apply orthogonal matrix used in reduction to tridiagonal
574584
* form to eigenvectors returned by DSTEIN.

lapack-netlib/SRC/dsbgvx.f

Lines changed: 17 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -263,13 +263,14 @@
263263
*> INFO is INTEGER
264264
*> = 0: successful exit
265265
*> < 0: if INFO = -i, the i-th argument had an illegal value
266-
*> <= N: if INFO = i, then i eigenvectors failed to converge.
267-
*> Their indices are stored in IFAIL.
268-
*> > N: DPBSTF returned an error code; i.e.,
269-
*> if INFO = N + i, for 1 <= i <= N, then the leading
270-
*> principal minor of order i of B is not positive.
271-
*> The factorization of B could not be completed and
272-
*> no eigenvalues or eigenvectors were computed.
266+
*> <= N: if INFO = i, then i eigenvectors failed to converge
267+
*> in DSTEIN; their indices are stored in IFAIL.
268+
*> N+1..2N: if INFO = N + i, for 1 <= i <= N, then DPBSTF
269+
*> returned an error code; the leading principal minor
270+
*> of order i of B is not positive. No eigenvalues or
271+
*> eigenvectors were computed.
272+
*> > 2N: if INFO = 2*N + i, then DSTEBZ returned
273+
*> INFO = i; see DSTEBZ for details.
273274
*> \endverbatim
274275
*
275276
* Authors:
@@ -462,12 +463,19 @@ SUBROUTINE DSBGVX( JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB,
462463
CALL DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL,
463464
$ WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
464465
$ IWORK( 1 ), IWORK( INDISP ), WORK( INDWRK ),
465-
$ IWORK( INDIWO ), INFO )
466+
$ IWORK( INDIWO ), IINFO )
467+
IF( IINFO.NE.0 ) THEN
468+
INFO = 2*N + IINFO
469+
IF( IINFO.NE.1 )
470+
$ GO TO 30
471+
END IF
466472
*
467473
IF( WANTZ ) THEN
468474
CALL DSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
469475
$ IWORK( 1 ), IWORK( INDISP ), Z, LDZ,
470-
$ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
476+
$ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, IINFO )
477+
IF( IINFO.NE.0 .AND. INFO.EQ.0 )
478+
$ INFO = IINFO
471479
*
472480
* Apply transformation matrix used in reduction to tridiagonal
473481
* form to eigenvectors returned by DSTEIN.

lapack-netlib/SRC/dspevx.f

Lines changed: 14 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -213,8 +213,11 @@
213213
*> INFO is INTEGER
214214
*> = 0: successful exit
215215
*> < 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.
216+
*> > 0: if INFO = i, and i is:
217+
*> <= N: then i eigenvectors failed to converge in
218+
*> DSTEIN; their indices are stored in IFAIL.
219+
*> > N: DSTEBZ returned INFO = INFO - N;
220+
*> see DSTEBZ for details.
218221
*> \endverbatim
219222
*
220223
* Authors:
@@ -429,12 +432,19 @@ SUBROUTINE DSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU,
429432
CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
430433
$ WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
431434
$ IWORK( 1 ), IWORK( INDISP ), WORK( INDWRK ),
432-
$ IWORK( INDIWO ), INFO )
435+
$ IWORK( INDIWO ), IINFO )
436+
IF( IINFO.NE.0 ) THEN
437+
INFO = N + IINFO
438+
IF( IINFO.NE.1 )
439+
$ GO TO 20
440+
END IF
433441
*
434442
IF( WANTZ ) THEN
435443
CALL DSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
436444
$ IWORK( 1 ), IWORK( INDISP ), Z, LDZ,
437-
$ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
445+
$ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, IINFO )
446+
IF( IINFO.NE.0 .AND. INFO.EQ.0 )
447+
$ INFO = IINFO
438448
*
439449
* Apply orthogonal matrix used in reduction to tridiagonal
440450
* form to eigenvectors returned by DSTEIN.

0 commit comments

Comments
 (0)