floraachy
/
OpenBLAS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #3837 from martin-frbg/lapack655+697 

Improve convergence of LAPACK ?LAED4 and fix a bug in DORCSD2BY1 (Reference-LAPACK PRs 655+697)
This commit is contained in:
Martin Kroeker 2022-11-22 13:51:57 +01:00 committed by GitHub
parent cabf9453e2 d321357558
commit ba8fb8b4b2
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 13 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lapack-netlib/SRC/dlaed4.f
View File

@ -330,7 +330,10 @@
IF( C.EQ.ZERO ) THEN IF( C.EQ.ZERO ) THEN
* ETA = B/A * ETA = B/A
* ETA = RHO - TAU * ETA = RHO - TAU
ETA = DLTUB - TAU * ETA = DLTUB - TAU
*
* Update proposed by Li, Ren-Cang:
ETA = -W / ( DPSI+DPHI )
ELSE IF( A.GE.ZERO ) THEN ELSE IF( A.GE.ZERO ) THEN
ETA = ( A+SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C ) ETA = ( A+SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
ELSE ELSE

6
lapack-netlib/SRC/dorcsd2by1.f
View File

@ -580,7 +580,7 @@
* Simultaneously diagonalize X11 and X21. * Simultaneously diagonalize X11 and X21.
* *
CALL DBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, CALL DBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA,
$ WORK(IPHI), V1T, LDV1T, DUM2, 1, U1, LDU1, U2, $ WORK(IPHI), V1T, LDV1T, DUM1, 1, U1, LDU1, U2,
$ LDU2, WORK(IB11D), WORK(IB11E), WORK(IB12D), $ LDU2, WORK(IB11D), WORK(IB11E), WORK(IB12D),
$ WORK(IB12E), WORK(IB21D), WORK(IB21E), $ WORK(IB12E), WORK(IB21D), WORK(IB21E),
$ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD,
@ -635,7 +635,7 @@
* Simultaneously diagonalize X11 and X21. * Simultaneously diagonalize X11 and X21.
* *
CALL DBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, CALL DBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P,
$ THETA, WORK(IPHI), DUM2, 1, V1T, LDV1T, U2, $ THETA, WORK(IPHI), DUM1, 1, V1T, LDV1T, U2,
$ LDU2, U1, LDU1, WORK(IB11D), WORK(IB11E), $ LDU2, U1, LDU1, WORK(IB11D), WORK(IB11E),
$ WORK(IB12D), WORK(IB12E), WORK(IB21D), $ WORK(IB12D), WORK(IB12E), WORK(IB21D),
$ WORK(IB21E), WORK(IB22D), WORK(IB22E), $ WORK(IB21E), WORK(IB22D), WORK(IB22E),
@ -706,7 +706,7 @@
* Simultaneously diagonalize X11 and X21. * Simultaneously diagonalize X11 and X21.
* *
CALL DBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, CALL DBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q,
$ THETA, WORK(IPHI), U2, LDU2, U1, LDU1, DUM2, $ THETA, WORK(IPHI), U2, LDU2, U1, LDU1, DUM1,
$ 1, V1T, LDV1T, WORK(IB11D), WORK(IB11E), $ 1, V1T, LDV1T, WORK(IB11D), WORK(IB11E),
$ WORK(IB12D), WORK(IB12E), WORK(IB21D), $ WORK(IB12D), WORK(IB12E), WORK(IB21D),
$ WORK(IB21E), WORK(IB22D), WORK(IB22E), $ WORK(IB21E), WORK(IB22D), WORK(IB22E),

5
lapack-netlib/SRC/slaed4.f
View File

@ -330,7 +330,10 @@
IF( C.EQ.ZERO ) THEN IF( C.EQ.ZERO ) THEN
* ETA = B/A * ETA = B/A
* ETA = RHO - TAU * ETA = RHO - TAU
ETA = DLTUB - TAU * ETA = DLTUB - TAU
*
* Update proposed by Li, Ren-Cang:
ETA = -W / ( DPSI+DPHI )
ELSE IF( A.GE.ZERO ) THEN ELSE IF( A.GE.ZERO ) THEN
ETA = ( A+SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C ) ETA = ( A+SQRT( ABS( A*A-FOUR*B*C ) ) ) / ( TWO*C )
ELSE ELSE