Skip to content

Drop the absolute floor from the splitting test in ?STEBZ (Reference-LAPACK PR 1385) #6184

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

Merged
martin-frbg merged 6 commits into from
Oct 28, 2026
Merged

Drop the absolute floor from the splitting test in ?STEBZ (Reference-LAPACK PR 1385) #6184

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
0c58a6a
Drop the absolute floor from the splitting test in ?STEBZ (Reference-…
martin-frbg Oct 27, 2026
de3bbd6
Drop the absolute floor from the splitting test in ?STEBZ (Reference-…
martin-frbg Oct 27, 2026
99b04f0
Drop the absolute floor from the splitting test in ?STEBZ (Reference-…
martin-frbg Oct 27, 2026
fc3ba40
Merge branch 'OpenMathLib:develop' into lapack1385
martin-frbg Oct 27, 2026
62a8ad0
Merge branch 'OpenMathLib:develop' into lapack1385
martin-frbg Oct 27, 2026
67169c8
Rename XER_REPLACE back to XERBLA for now
martin-frbg Oct 28, 2026
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
2 changes: 1 addition & 1 deletion lapack-netlib/SRC/dlaebz.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -63,7 +63,7 @@
*> Note that the intervals are in all cases half-open intervals,
*> i.e., of the form (a,b] , which includes b but not a .
*>
*> To avoid underflow, the matrix should be scaled so that its largest
*> To avoid overflow, the matrix should be scaled so that its largest
*> element is no greater than overflow**(1/2) * underflow**(1/4)
*> in absolute value. To assure the most accurate computation
*> of small eigenvalues, the matrix should be scaled to be
Expand Down
66 changes: 35 additions & 31 deletions lapack-netlib/SRC/dstebz.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -226,8 +226,6 @@ typedef struct Namelist Namelist;
*/




/* Table of constant values */

static integer c__1 = 1;
Expand All @@ -243,7 +241,6 @@ static integer c__0 = 0;
/* Online html documentation available at */
/* http://www.netlib.org/lapack/explore-html/ */

/* > \htmlonly */
/* > Download DSTEBZ + dependencies */
/* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dstebz.
f"> */
Expand All @@ -254,7 +251,6 @@ f"> */
/* > <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dstebz.
f"> */
/* > [TXT]</a> */
/* > \endhtmlonly */

/* Definition: */
/* =========== */
Expand Down Expand Up @@ -502,9 +498,7 @@ f"> */
/* > \author Univ. of Colorado Denver */
/* > \author NAG Ltd. */

/* > \date June 2016 */

/* > \ingroup auxOTHERcomputational */
/* > \ingroup stebz */

/* ===================================================================== */
/* Subroutine */ void dstebz_(char *range, char *order, integer *n, doublereal
Expand All @@ -518,47 +512,46 @@ f"> */
doublereal d__1, d__2, d__3, d__4, d__5;

/* Local variables */
integer iend, ioff, iout, itmp1, j, jdisc;
integer j, ib, jb, ie, je, nb;
doublereal gl;
integer im, in;
doublereal gu;
integer iw;
doublereal wl, wu;
integer nwl;
doublereal ulp, wlu, wul;
integer nwu;
doublereal tmp1, tmp2;
integer iend, ioff, iout, itmp1, jdisc;
extern logical lsame_(char *, char *);
integer iinfo;
doublereal atoli;
integer iwoff;
doublereal bnorm;
integer itmax;
doublereal wkill, rtoli, tnorm;
integer ib, jb, ie, je, nb;
doublereal gl;
integer im, in;
extern doublereal dlamch_(char *);
integer ibegin;
doublereal gu;
integer iw;
extern /* Subroutine */ void dlaebz_(integer *, integer *, integer *,
integer *, integer *, integer *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *, integer *,
doublereal *, doublereal *, integer *, integer *, doublereal *,
integer *, integer *);
doublereal wl;
integer irange, idiscl;
doublereal safemn, wu;
doublereal safemn;
integer idumma[1];
extern /* Subroutine */ void xerbla_(char *, integer *, ftnlen);
extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
integer *, integer *, ftnlen, ftnlen);
extern /* Subroutine */ void xerbla_(char *, integer *, ftnlen);
integer idiscu, iorder;
logical ncnvrg;
doublereal pivmin;
logical toofew;
integer nwl;
doublereal ulp, wlu, wul;
integer nwu;
doublereal tmp1, tmp2;


/* -- LAPACK computational routine (version 3.7.0) -- */
/* -- LAPACK computational routine -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
/* June 2016 */


/* ===================================================================== */
Expand Down Expand Up @@ -680,10 +673,17 @@ f"> */
/* Computing 2nd power */
d__1 = e[j - 1];
tmp1 = d__1 * d__1;
/* Computing 2nd power */
d__2 = ulp;
if ((d__1 = d__[j] * d__[j - 1], abs(d__1)) * (d__2 * d__2) + safemn
> tmp1) {
/* Split where e(j)**2 < ulp**2 |d(j) d(j+1)| (Kahan's relative */
/* criterion, as in xLARRA) or e(j) = 0. No absolute floor: the */
/* drivers scale small matrices to sqrt(SAFEMN/ULP), where a floor */
/* of SAFEMN on e(j)**2 would discard off-diagonals as large as */
/* sqrt(ULP) relative to the matrix. The threshold is formed as */
/* a product of scaled factors so that it cannot overflow before */
/* e(j)**2 does. */

tmp2 = (d__1 = d__[j], abs(d__1)) * ulp * ((d__2 = d__[j - 1], abs(
d__2)) * ulp);
if (tmp1 < tmp2 || tmp1 == 0.) {
isplit[*nsplit] = j - 1;
++(*nsplit);
work[j - 1] = 0.;
Expand Down Expand Up @@ -841,8 +841,8 @@ f"> */
if (irange == 1 || wu >= d__[ibegin] - pivmin) {
++nwu;
}
if (irange == 1 || (wl < d__[ibegin] - pivmin && wu >= d__[ibegin]
- pivmin)) {
if (irange == 1 || wl < d__[ibegin] - pivmin && wu >= d__[ibegin]
- pivmin) {
++(*m);
w[*m] = d__[ibegin];
iblock[*m] = jb;
Expand Down Expand Up @@ -894,7 +894,7 @@ f"> */
}

if (irange > 1) {
if (gu < wl) {
if (gu <= wl) {
nwl += in;
nwu += in;
goto L70;
Expand Down Expand Up @@ -1007,7 +1007,9 @@ f"> */
}
/* L90: */
}
iblock[iw] = 0;
if (iw != 0) {
iblock[iw] = 0;
}
/* L100: */
}
}
Expand All @@ -1025,7 +1027,9 @@ f"> */
}
/* L110: */
}
iblock[iw] = 0;
if (iw != 0) {
iblock[iw] = 0;
}
/* L120: */
}
}
Expand Down
31 changes: 21 additions & 10 deletions lapack-netlib/SRC/dstebz.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,15 +5,13 @@
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DSTEBZ + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dstebz.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dstebz.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dstebz.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
Expand Down Expand Up @@ -264,12 +262,14 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup auxOTHERcomputational
*> \ingroup stebz
*
* =====================================================================
SUBROUTINE DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E,
SUBROUTINE DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D,
$ E,
$ M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK,
$ INFO )
IMPLICIT NONE
*
* -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
Expand Down Expand Up @@ -419,7 +419,16 @@ SUBROUTINE DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E,
*
DO 10 J = 2, N
TMP1 = E( J-1 )**2
IF( ABS( D( J )*D( J-1 ) )*ULP**2+SAFEMN.GT.TMP1 ) THEN
* Split where e(j)**2 < ulp**2 |d(j) d(j+1)| (Kahan's relative
* criterion, as in xLARRA) or e(j) = 0. No absolute floor: the
* drivers scale small matrices to sqrt(SAFEMN/ULP), where a floor
* of SAFEMN on e(j)**2 would discard off-diagonals as large as
* sqrt(ULP) relative to the matrix. The threshold is formed as
* a product of scaled factors so that it cannot overflow before
* e(j)**2 does.
*
TMP2 = ( ABS( D( J ) )*ULP )*( ABS( D( J-1 ) )*ULP )
IF( TMP1.LT.TMP2 .OR. TMP1.EQ.ZERO ) THEN
ISPLIT( NSPLIT ) = J - 1
NSPLIT = NSPLIT + 1
WORK( J-1 ) = ZERO
Expand Down Expand Up @@ -481,7 +490,8 @@ SUBROUTINE DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E,
IWORK( 5 ) = IL - 1
IWORK( 6 ) = IU
*
CALL DLAEBZ( 3, ITMAX, N, 2, 2, NB, ATOLI, RTOLI, PIVMIN, D, E,
CALL DLAEBZ( 3, ITMAX, N, 2, 2, NB, ATOLI, RTOLI, PIVMIN, D,
$ E,
$ WORK, IWORK( 5 ), WORK( N+1 ), WORK( N+5 ), IOUT,
$ IWORK, W, IBLOCK, IINFO )
*
Expand Down Expand Up @@ -595,7 +605,7 @@ SUBROUTINE DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E,
END IF
*
IF( IRANGE.GT.1 ) THEN
IF( GU.LT.WL ) THEN
IF( GU.LE.WL ) THEN
NWL = NWL + IN
NWU = NWU + IN
GO TO 70
Expand Down Expand Up @@ -623,7 +633,8 @@ SUBROUTINE DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E,
*
ITMAX = INT( ( LOG( GU-GL+PIVMIN )-LOG( PIVMIN ) ) /
$ LOG( TWO ) ) + 2
CALL DLAEBZ( 2, ITMAX, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN,
CALL DLAEBZ( 2, ITMAX, IN, IN, 1, NB, ATOLI, RTOLI,
$ PIVMIN,
$ D( IBEGIN ), E( IBEGIN ), WORK( IBEGIN ),
$ IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IOUT,
$ IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO )
Expand Down Expand Up @@ -698,7 +709,7 @@ SUBROUTINE DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E,
WKILL = W( JE )
END IF
90 CONTINUE
IBLOCK( IW ) = 0
IF( IW .NE. 0) IBLOCK( IW ) = 0
100 CONTINUE
END IF
IF( IDISCU.GT.0 ) THEN
Expand All @@ -713,7 +724,7 @@ SUBROUTINE DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E,
WKILL = W( JE )
END IF
110 CONTINUE
IBLOCK( IW ) = 0
IF( IW .NE. 0) IBLOCK( IW ) = 0
120 CONTINUE
END IF
IM = 0
Expand Down
2 changes: 1 addition & 1 deletion lapack-netlib/SRC/slaebz.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -63,7 +63,7 @@
*> Note that the intervals are in all cases half-open intervals,
*> i.e., of the form (a,b] , which includes b but not a .
*>
*> To avoid underflow, the matrix should be scaled so that its largest
*> To avoid overflow, the matrix should be scaled so that its largest
*> element is no greater than overflow**(1/2) * underflow**(1/4)
*> in absolute value. To assure the most accurate computation
*> of small eigenvalues, the matrix should be scaled to be
Expand Down
Loading
Loading