Skip to content

Bound the bracket widening in xLARRB and xLARRJ so that a NaN matrix cannot hang xSTEMR #1389

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
rmlarsen wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Bound the bracket widening in xLARRB and xLARRJ so that a NaN matrix cannot hang xSTEMR #1389

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions SRC/clarrv.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -702,6 +702,10 @@ SUBROUTINE CLARRV( N, VL, VU, D, L, PIVMIN,
$ WERR(WBEGIN),WORK( INDWRK ),
$ IWORK( IINDWK ), PIVMIN, SPDIAM,
$ IN, IINFO )
IF( IINFO.NE.0 ) THEN
INFO = -1
RETURN
END IF
55 CONTINUE
*
IF((WBEGIN+NEWLST-1.LT.DOL).OR.
Expand Down
11 changes: 8 additions & 3 deletions SRC/cstemr.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -304,10 +304,11 @@
*> = 0: successful exit
*> < 0: if INFO = -i, the i-th argument had an illegal value
*> > 0: if INFO = 1X, internal error in SLARRE,
*> if INFO = 2X, internal error in CLARRV.
*> if INFO = 2X, internal error in CLARRV,
*> if INFO = 3X, internal error in SLARRJ.
*> Here, the digit X = ABS( IINFO ) < 10, where IINFO is
*> the nonzero error code returned by SLARRE or
*> CLARRV, respectively.
*> the nonzero error code returned by SLARRE, CLARRV
*> or SLARRJ, respectively.
*> \endverbatim
*
* Authors:
Expand Down Expand Up @@ -752,6 +753,10 @@ SUBROUTINE CSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
$ WORK( INDERR+WBEGIN-1 ),
$ WORK( INDWRK ), IWORK( IINDWK ), PIVMIN,
$ TNRM, IINFO )
IF( IINFO.NE.0 ) THEN
INFO = 30 + ABS( IINFO )
RETURN
END IF
IBEGIN = IEND + 1
WBEGIN = WEND + 1
39 CONTINUE
Expand Down
38 changes: 29 additions & 9 deletions SRC/dlarrb.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -165,7 +165,11 @@
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
*> Error flag.
*> = 0: successful exit
*> = 1: the interval around one of the eigenvalues could not
*> be widened to contain it: the Sturm counts of the
*> representation are inconsistent, as they are when it
*> contains a NaN or an Inf.
*> \endverbatim
*
* Authors:
Expand Down Expand Up @@ -274,10 +278,23 @@ SUBROUTINE DLARRB( N, D, LLD, IFIRST, ILAST, RTOL1,
*
* Do while( NEGCNT(LEFT).GT.I-1 )
*
BACK = WERR( II )
* The interval is widened by BACK, doubled at every step, until
* the Sturm count agrees with the index. In exact arithmetic
* this terminates because the count is 0 below the spectrum and
* N above it. A NaN or an Inf in the representation is never
* counted, so the count can stay short of the index; stop once
* BACK has overflowed, when no further step can move the
* endpoint. BACK starts at no less than the minimum interval
* width so that a zero WERR still makes progress.
*
BACK = MAX( WERR( II ), MNWDTH )
20 CONTINUE
NEGCNT = DLANEG( N, D, LLD, LEFT, PIVMIN, R )
IF( NEGCNT.GT.I-1 ) THEN
IF( .NOT.( BACK.LT.TWO*BACK ) ) THEN
INFO = 1
RETURN
END IF
LEFT = LEFT - BACK
BACK = TWO*BACK
GO TO 20
Expand All @@ -286,15 +303,18 @@ SUBROUTINE DLARRB( N, D, LLD, IFIRST, ILAST, RTOL1,
* Do while( NEGCNT(RIGHT).LT.I )
* Compute negcount from dstqds facto L+D+L+^T = L D L^T - RIGHT
*
BACK = WERR( II )
BACK = MAX( WERR( II ), MNWDTH )
50 CONTINUE

NEGCNT = DLANEG( N, D, LLD, RIGHT, PIVMIN, R )
IF( NEGCNT.LT.I ) THEN
RIGHT = RIGHT + BACK
BACK = TWO*BACK
GO TO 50
END IF
IF( NEGCNT.LT.I ) THEN
IF( .NOT.( BACK.LT.TWO*BACK ) ) THEN
INFO = 1
RETURN
END IF
RIGHT = RIGHT + BACK
BACK = TWO*BACK
GO TO 50
END IF
WIDTH = HALF*ABS( LEFT - RIGHT )
TMP = MAX( ABS( LEFT ), ABS( RIGHT ) )
CVRGD = MAX(RTOL1*GAP,RTOL2*TMP)
Expand Down
37 changes: 29 additions & 8 deletions SRC/dlarrj.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -137,7 +137,11 @@
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
*> Error flag.
*> = 0: successful exit
*> = 1: the interval around one of the eigenvalues could not
*> be widened to contain it: the Sturm counts of the
*> matrix are inconsistent, as they are when it contains
*> a NaN or an Inf.
*> \endverbatim
*
* Authors:
Expand Down Expand Up @@ -190,7 +194,7 @@ SUBROUTINE DLARRJ( N, D, E2, IFIRST, ILAST,
* .. Local Scalars ..
INTEGER CNT, I, I1, I2, II, ITER, J, K, NEXT, NINT,
$ OLNINT, P, PREV, SAVI1
DOUBLE PRECISION DPLUS, FAC, LEFT, MID, RIGHT, S, TMP, WIDTH
DOUBLE PRECISION BACK, DPLUS, LEFT, MID, RIGHT, S, TMP, WIDTH
*
* ..
* .. Intrinsic Functions ..
Expand Down Expand Up @@ -249,7 +253,16 @@ SUBROUTINE DLARRJ( N, D, E2, IFIRST, ILAST,
*
* Do while( CNT(LEFT).GT.I-1 )
*
FAC = ONE
* The interval is widened by BACK, doubled at every step,
* until the Sturm count agrees with the index. In exact
* arithmetic this terminates because the count is 0 below the
* spectrum and N above it. A NaN or an Inf in the matrix is
* never counted, so the count can stay short of the index;
* stop once BACK has overflowed, when no further step can move
* the endpoint. BACK starts at no less than the minimum
* interval width so that a zero WERR still makes progress.
*
BACK = MAX( WERR( II ), TWO*PIVMIN )
20 CONTINUE
CNT = 0
S = LEFT
Expand All @@ -260,14 +273,18 @@ SUBROUTINE DLARRJ( N, D, E2, IFIRST, ILAST,
IF( DPLUS.LT.ZERO ) CNT = CNT + 1
30 CONTINUE
IF( CNT.GT.I-1 ) THEN
LEFT = LEFT - WERR( II )*FAC
FAC = TWO*FAC
IF( .NOT.( BACK.LT.TWO*BACK ) ) THEN
INFO = 1
RETURN
END IF
LEFT = LEFT - BACK
BACK = TWO*BACK
GO TO 20
END IF
*
* Do while( CNT(RIGHT).LT.I )
*
FAC = ONE
BACK = MAX( WERR( II ), TWO*PIVMIN )
50 CONTINUE
CNT = 0
S = RIGHT
Expand All @@ -278,8 +295,12 @@ SUBROUTINE DLARRJ( N, D, E2, IFIRST, ILAST,
IF( DPLUS.LT.ZERO ) CNT = CNT + 1
60 CONTINUE
IF( CNT.LT.I ) THEN
RIGHT = RIGHT + WERR( II )*FAC
FAC = TWO*FAC
IF( .NOT.( BACK.LT.TWO*BACK ) ) THEN
INFO = 1
RETURN
END IF
RIGHT = RIGHT + BACK
BACK = TWO*BACK
GO TO 50
END IF
NINT = NINT + 1
Expand Down
4 changes: 4 additions & 0 deletions SRC/dlarrv.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -698,6 +698,10 @@ SUBROUTINE DLARRV( N, VL, VU, D, L, PIVMIN,
$ WERR(WBEGIN),WORK( INDWRK ),
$ IWORK( IINDWK ), PIVMIN, SPDIAM,
$ IN, IINFO )
IF( IINFO.NE.0 ) THEN
INFO = -1
RETURN
END IF
55 CONTINUE
*
IF((WBEGIN+NEWLST-1.LT.DOL).OR.
Expand Down
11 changes: 8 additions & 3 deletions SRC/dstemr.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -287,10 +287,11 @@
*> = 0: successful exit
*> < 0: if INFO = -i, the i-th argument had an illegal value
*> > 0: if INFO = 1X, internal error in DLARRE,
*> if INFO = 2X, internal error in DLARRV.
*> if INFO = 2X, internal error in DLARRV,
*> if INFO = 3X, internal error in DLARRJ.
*> Here, the digit X = ABS( IINFO ) < 10, where IINFO is
*> the nonzero error code returned by DLARRE or
*> DLARRV, respectively.
*> the nonzero error code returned by DLARRE, DLARRV
*> or DLARRJ, respectively.
*> \endverbatim
*
* Authors:
Expand Down Expand Up @@ -735,6 +736,10 @@ SUBROUTINE DSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
$ WORK( INDERR+WBEGIN-1 ),
$ WORK( INDWRK ), IWORK( IINDWK ), PIVMIN,
$ TNRM, IINFO )
IF( IINFO.NE.0 ) THEN
INFO = 30 + ABS( IINFO )
RETURN
END IF
IBEGIN = IEND + 1
WBEGIN = WEND + 1
39 CONTINUE
Expand Down
38 changes: 29 additions & 9 deletions SRC/slarrb.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -165,7 +165,11 @@
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
*> Error flag.
*> = 0: successful exit
*> = 1: the interval around one of the eigenvalues could not
*> be widened to contain it: the Sturm counts of the
*> representation are inconsistent, as they are when it
*> contains a NaN or an Inf.
*> \endverbatim
*
* Authors:
Expand Down Expand Up @@ -274,10 +278,23 @@ SUBROUTINE SLARRB( N, D, LLD, IFIRST, ILAST, RTOL1,
*
* Do while( NEGCNT(LEFT).GT.I-1 )
*
BACK = WERR( II )
* The interval is widened by BACK, doubled at every step, until
* the Sturm count agrees with the index. In exact arithmetic
* this terminates because the count is 0 below the spectrum and
* N above it. A NaN or an Inf in the representation is never
* counted, so the count can stay short of the index; stop once
* BACK has overflowed, when no further step can move the
* endpoint. BACK starts at no less than the minimum interval
* width so that a zero WERR still makes progress.
*
BACK = MAX( WERR( II ), MNWDTH )
20 CONTINUE
NEGCNT = SLANEG( N, D, LLD, LEFT, PIVMIN, R )
IF( NEGCNT.GT.I-1 ) THEN
IF( .NOT.( BACK.LT.TWO*BACK ) ) THEN
INFO = 1
RETURN
END IF
LEFT = LEFT - BACK
BACK = TWO*BACK
GO TO 20
Expand All @@ -286,15 +303,18 @@ SUBROUTINE SLARRB( N, D, LLD, IFIRST, ILAST, RTOL1,
* Do while( NEGCNT(RIGHT).LT.I )
* Compute negcount from dstqds facto L+D+L+^T = L D L^T - RIGHT
*
BACK = WERR( II )
BACK = MAX( WERR( II ), MNWDTH )
50 CONTINUE

NEGCNT = SLANEG( N, D, LLD, RIGHT, PIVMIN, R )
IF( NEGCNT.LT.I ) THEN
RIGHT = RIGHT + BACK
BACK = TWO*BACK
GO TO 50
END IF
IF( NEGCNT.LT.I ) THEN
IF( .NOT.( BACK.LT.TWO*BACK ) ) THEN
INFO = 1
RETURN
END IF
RIGHT = RIGHT + BACK
BACK = TWO*BACK
GO TO 50
END IF
WIDTH = HALF*ABS( LEFT - RIGHT )
TMP = MAX( ABS( LEFT ), ABS( RIGHT ) )
CVRGD = MAX(RTOL1*GAP,RTOL2*TMP)
Expand Down
37 changes: 29 additions & 8 deletions SRC/slarrj.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -137,7 +137,11 @@
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
*> Error flag.
*> = 0: successful exit
*> = 1: the interval around one of the eigenvalues could not
*> be widened to contain it: the Sturm counts of the
*> matrix are inconsistent, as they are when it contains
*> a NaN or an Inf.
*> \endverbatim
*
* Authors:
Expand Down Expand Up @@ -190,7 +194,7 @@ SUBROUTINE SLARRJ( N, D, E2, IFIRST, ILAST,
* .. Local Scalars ..
INTEGER CNT, I, I1, I2, II, ITER, J, K, NEXT, NINT,
$ OLNINT, P, PREV, SAVI1
REAL DPLUS, FAC, LEFT, MID, RIGHT, S, TMP, WIDTH
REAL BACK, DPLUS, LEFT, MID, RIGHT, S, TMP, WIDTH
*
* ..
* .. Intrinsic Functions ..
Expand Down Expand Up @@ -249,7 +253,16 @@ SUBROUTINE SLARRJ( N, D, E2, IFIRST, ILAST,
*
* Do while( CNT(LEFT).GT.I-1 )
*
FAC = ONE
* The interval is widened by BACK, doubled at every step,
* until the Sturm count agrees with the index. In exact
* arithmetic this terminates because the count is 0 below the
* spectrum and N above it. A NaN or an Inf in the matrix is
* never counted, so the count can stay short of the index;
* stop once BACK has overflowed, when no further step can move
* the endpoint. BACK starts at no less than the minimum
* interval width so that a zero WERR still makes progress.
*
BACK = MAX( WERR( II ), TWO*PIVMIN )
20 CONTINUE
CNT = 0
S = LEFT
Expand All @@ -260,14 +273,18 @@ SUBROUTINE SLARRJ( N, D, E2, IFIRST, ILAST,
IF( DPLUS.LT.ZERO ) CNT = CNT + 1
30 CONTINUE
IF( CNT.GT.I-1 ) THEN
LEFT = LEFT - WERR( II )*FAC
FAC = TWO*FAC
IF( .NOT.( BACK.LT.TWO*BACK ) ) THEN
INFO = 1
RETURN
END IF
LEFT = LEFT - BACK
BACK = TWO*BACK
GO TO 20
END IF
*
* Do while( CNT(RIGHT).LT.I )
*
FAC = ONE
BACK = MAX( WERR( II ), TWO*PIVMIN )
50 CONTINUE
CNT = 0
S = RIGHT
Expand All @@ -278,8 +295,12 @@ SUBROUTINE SLARRJ( N, D, E2, IFIRST, ILAST,
IF( DPLUS.LT.ZERO ) CNT = CNT + 1
60 CONTINUE
IF( CNT.LT.I ) THEN
RIGHT = RIGHT + WERR( II )*FAC
FAC = TWO*FAC
IF( .NOT.( BACK.LT.TWO*BACK ) ) THEN
INFO = 1
RETURN
END IF
RIGHT = RIGHT + BACK
BACK = TWO*BACK
GO TO 50
END IF
NINT = NINT + 1
Expand Down
4 changes: 4 additions & 0 deletions SRC/slarrv.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -698,6 +698,10 @@ SUBROUTINE SLARRV( N, VL, VU, D, L, PIVMIN,
$ WERR(WBEGIN),WORK( INDWRK ),
$ IWORK( IINDWK ), PIVMIN, SPDIAM,
$ IN, IINFO )
IF( IINFO.NE.0 ) THEN
INFO = -1
RETURN
END IF
55 CONTINUE
*
IF((WBEGIN+NEWLST-1.LT.DOL).OR.
Expand Down
11 changes: 8 additions & 3 deletions SRC/sstemr.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -287,10 +287,11 @@
*> = 0: successful exit
*> < 0: if INFO = -i, the i-th argument had an illegal value
*> > 0: if INFO = 1X, internal error in SLARRE,
*> if INFO = 2X, internal error in SLARRV.
*> if INFO = 2X, internal error in SLARRV,
*> if INFO = 3X, internal error in SLARRJ.
*> Here, the digit X = ABS( IINFO ) < 10, where IINFO is
*> the nonzero error code returned by SLARRE or
*> SLARRV, respectively.
*> the nonzero error code returned by SLARRE, SLARRV
*> or SLARRJ, respectively.
*> \endverbatim
*
* Authors:
Expand Down Expand Up @@ -732,6 +733,10 @@ SUBROUTINE SSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
$ WORK( INDERR+WBEGIN-1 ),
$ WORK( INDWRK ), IWORK( IINDWK ), PIVMIN,
$ TNRM, IINFO )
IF( IINFO.NE.0 ) THEN
INFO = 30 + ABS( IINFO )
RETURN
END IF
IBEGIN = IEND + 1
WBEGIN = WEND + 1
39 CONTINUE
Expand Down
Loading
Loading