Skip to content

Increase tolerance in ?LASD2 to improve ?BDSDC stability (Reference-LAPACK PR 1286) #5858

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
martin-frbg wants to merge 2 commits into
base: develop
Choose a base branch
from
+22 −16
Open

Increase tolerance in ?LASD2 to improve ?BDSDC stability (Reference-LAPACK PR 1286) #5858

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
ea007b5
Increase deflation tolerance to match ?LASD7 (Reference-LAPACK PR 1286)
martin-frbg Jun 24, 2026
100988f
Merge branch 'OpenMathLib:develop' into lapack1286
martin-frbg Jun 25, 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
19 changes: 11 additions & 8 deletions lapack-netlib/SRC/dlasd2.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 DLASD2 + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasd2.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasd2.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasd2.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
Expand Down Expand Up @@ -254,7 +252,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup OTHERauxiliary
*> \ingroup lasd2
*
*> \par Contributors:
* ==================
Expand All @@ -263,9 +261,11 @@
*> California at Berkeley, USA
*>
* =====================================================================
SUBROUTINE DLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT,
SUBROUTINE DLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU,
$ VT,
$ LDVT, DSIGMA, U2, LDU2, VT2, LDVT2, IDXP, IDX,
$ IDXC, IDXQ, COLTYP, INFO )
IMPLICIT NONE
*
* -- LAPACK auxiliary routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
Expand Down Expand Up @@ -303,7 +303,8 @@ SUBROUTINE DLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT,
EXTERNAL DLAMCH, DLAPY2
* ..
* .. External Subroutines ..
EXTERNAL DCOPY, DLACPY, DLAMRG, DLASET, DROT, XERBLA
EXTERNAL DCOPY, DLACPY, DLAMRG, DLASET, DROT,
$ XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX
Expand Down Expand Up @@ -396,7 +397,7 @@ SUBROUTINE DLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT,
*
EPS = DLAMCH( 'Epsilon' )
TOL = MAX( ABS( ALPHA ), ABS( BETA ) )
TOL = EIGHT*EPS*MAX( ABS( D( N ) ), TOL )
TOL = EIGHT*EIGHT*EPS*MAX( ABS( D( N ) ), TOL )
*
* There are 2 kinds of deflation -- first a value in the z-vector
* is small, second two (or more) singular values are very close
Expand Down Expand Up @@ -479,7 +480,8 @@ SUBROUTINE DLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT,
IDXJ = IDXJ - 1
END IF
CALL DROT( N, U( 1, IDXJP ), 1, U( 1, IDXJ ), 1, C, S )
CALL DROT( M, VT( IDXJP, 1 ), LDVT, VT( IDXJ, 1 ), LDVT, C,
CALL DROT( M, VT( IDXJP, 1 ), LDVT, VT( IDXJ, 1 ), LDVT,
$ C,
$ S )
IF( COLTYP( J ).NE.COLTYP( JPREV ) ) THEN
COLTYP( J ) = 3
Expand Down Expand Up @@ -621,7 +623,8 @@ SUBROUTINE DLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT,
CALL DCOPY( N-K, DSIGMA( K+1 ), 1, D( K+1 ), 1 )
CALL DLACPY( 'A', N, N-K, U2( 1, K+1 ), LDU2, U( 1, K+1 ),
$ LDU )
CALL DLACPY( 'A', N-K, M, VT2( K+1, 1 ), LDVT2, VT( K+1, 1 ),
CALL DLACPY( 'A', N-K, M, VT2( K+1, 1 ), LDVT2, VT( K+1,
$ 1 ),
$ LDVT )
END IF
*
Expand Down
19 changes: 11 additions & 8 deletions lapack-netlib/SRC/slasd2.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 SLASD2 + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasd2.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasd2.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasd2.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
Expand Down Expand Up @@ -254,7 +252,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup OTHERauxiliary
*> \ingroup lasd2
*
*> \par Contributors:
* ==================
Expand All @@ -263,9 +261,11 @@
*> California at Berkeley, USA
*>
* =====================================================================
SUBROUTINE SLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT,
SUBROUTINE SLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU,
$ VT,
$ LDVT, DSIGMA, U2, LDU2, VT2, LDVT2, IDXP, IDX,
$ IDXC, IDXQ, COLTYP, INFO )
IMPLICIT NONE
*
* -- LAPACK auxiliary routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
Expand Down Expand Up @@ -303,7 +303,8 @@ SUBROUTINE SLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT,
EXTERNAL SLAMCH, SLAPY2
* ..
* .. External Subroutines ..
EXTERNAL SCOPY, SLACPY, SLAMRG, SLASET, SROT, XERBLA
EXTERNAL SCOPY, SLACPY, SLAMRG, SLASET, SROT,
$ XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX
Expand Down Expand Up @@ -396,7 +397,7 @@ SUBROUTINE SLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT,
*
EPS = SLAMCH( 'Epsilon' )
TOL = MAX( ABS( ALPHA ), ABS( BETA ) )
TOL = EIGHT*EPS*MAX( ABS( D( N ) ), TOL )
TOL = EIGHT*EIGHT*EPS*MAX( ABS( D( N ) ), TOL )
*
* There are 2 kinds of deflation -- first a value in the z-vector
* is small, second two (or more) singular values are very close
Expand Down Expand Up @@ -479,7 +480,8 @@ SUBROUTINE SLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT,
IDXJ = IDXJ - 1
END IF
CALL SROT( N, U( 1, IDXJP ), 1, U( 1, IDXJ ), 1, C, S )
CALL SROT( M, VT( IDXJP, 1 ), LDVT, VT( IDXJ, 1 ), LDVT, C,
CALL SROT( M, VT( IDXJP, 1 ), LDVT, VT( IDXJ, 1 ), LDVT,
$ C,
$ S )
IF( COLTYP( J ).NE.COLTYP( JPREV ) ) THEN
COLTYP( J ) = 3
Expand Down Expand Up @@ -621,7 +623,8 @@ SUBROUTINE SLASD2( NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT,
CALL SCOPY( N-K, DSIGMA( K+1 ), 1, D( K+1 ), 1 )
CALL SLACPY( 'A', N, N-K, U2( 1, K+1 ), LDU2, U( 1, K+1 ),
$ LDU )
CALL SLACPY( 'A', N-K, M, VT2( K+1, 1 ), LDVT2, VT( K+1, 1 ),
CALL SLACPY( 'A', N-K, M, VT2( K+1, 1 ), LDVT2, VT( K+1,
$ 1 ),
$ LDVT )
END IF
*
Expand Down
Loading