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

Correct the order of eigenvalues/vector for 2x2 matrices (Reference-LAPACK PR 867)

This commit is contained in:
Martin Kroeker 2023-07-05 10:10:13 +02:00 committed by GitHub
parent 4d0b7fbec0
commit 1363a7c4f1
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 115 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
lapack-netlib/SRC/cstemr.f
View File

@ -320,7 +320,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complexOTHERcomputational
*> \ingroup stemr
*
*> \par Contributors:
* ==================
@ -329,7 +329,8 @@
*> Jim Demmel, University of California, Berkeley, USA \n
*> Inderjit Dhillon, University of Texas, Austin, USA \n
*> Osni Marques, LBNL/NERSC, USA \n
*> Christof Voemel, University of California, Berkeley, USA
*> Christof Voemel, University of California, Berkeley, USA \n
*> Aravindh Krishnamoorthy, FAU, Erlangen, Germany \n
*
* =====================================================================
SUBROUTINE CSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
@ -361,7 +362,8 @@
$ MINRGP = 3.0E-3 )
* ..
* .. Local Scalars ..
LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY
LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY,
$ LAESWAP
INTEGER I, IBEGIN, IEND, IFIRST, IIL, IINDBL, IINDW,
$ IINDWK, IINFO, IINSPL, IIU, ILAST, IN, INDD,
$ INDE2, INDERR, INDGP, INDGRS, INDWRK, ITMP,
@ -397,6 +399,7 @@
*
LQUERY = ( ( LWORK.EQ.-1 ).OR.( LIWORK.EQ.-1 ) )
ZQUERY = ( NZC.EQ.-1 )
LAESWAP = .FALSE.
* SSTEMR needs WORK of size 6*N, IWORK of size 3*N.
* In addition, SLARRE needs WORK of size 6*N, IWORK of size 5*N.
@ -519,6 +522,15 @@
ELSE IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
CALL SLAEV2( D(1), E(1), D(2), R1, R2, CS, SN )
END IF
* D/S/LAE2 and D/S/LAEV2 outputs satisfy |R1| >= |R2|. However,
* the following code requires R1 >= R2. Hence, we correct
* the order of R1, R2, CS, SN if R1 < R2 before further processing.
IF( R1.LT.R2 ) THEN
E(2) = R1
R1 = R2
R2 = E(2)
LAESWAP = .TRUE.
ENDIF
IF( ALLEIG.OR.
$ (VALEIG.AND.(R2.GT.WL).AND.
$ (R2.LE.WU)).OR.
@ -526,8 +538,13 @@
M = M+1
W( M ) = R2
IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
Z( 1, M ) = -SN
Z( 2, M ) = CS
IF( LAESWAP ) THEN
Z( 1, M ) = CS
Z( 2, M ) = SN
ELSE
Z( 1, M ) = -SN
Z( 2, M ) = CS
ENDIF
* Note: At most one of SN and CS can be zero.
IF (SN.NE.ZERO) THEN
IF (CS.NE.ZERO) THEN
@ -550,8 +567,13 @@
M = M+1
W( M ) = R1
IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
Z( 1, M ) = CS
Z( 2, M ) = SN
IF( LAESWAP ) THEN
Z( 1, M ) = -SN
Z( 2, M ) = CS
ELSE
Z( 1, M ) = CS
Z( 2, M ) = SN
ENDIF
* Note: At most one of SN and CS can be zero.
IF (SN.NE.ZERO) THEN
IF (CS.NE.ZERO) THEN

36
lapack-netlib/SRC/dstemr.f
View File

@ -303,7 +303,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup doubleOTHERcomputational
*> \ingroup stemr
*
*> \par Contributors:
* ==================
@ -312,7 +312,8 @@
*> Jim Demmel, University of California, Berkeley, USA \n
*> Inderjit Dhillon, University of Texas, Austin, USA \n
*> Osni Marques, LBNL/NERSC, USA \n
*> Christof Voemel, University of California, Berkeley, USA
*> Christof Voemel, University of California, Berkeley, USA \n
*> Aravindh Krishnamoorthy, FAU, Erlangen, Germany \n
*
* =====================================================================
SUBROUTINE DSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
@ -344,7 +345,8 @@
$ MINRGP = 1.0D-3 )
* ..
* .. Local Scalars ..
LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY
LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY,
$ LAESWAP
INTEGER I, IBEGIN, IEND, IFIRST, IIL, IINDBL, IINDW,
$ IINDWK, IINFO, IINSPL, IIU, ILAST, IN, INDD,
$ INDE2, INDERR, INDGP, INDGRS, INDWRK, ITMP,
@ -380,6 +382,7 @@
*
LQUERY = ( ( LWORK.EQ.-1 ).OR.( LIWORK.EQ.-1 ) )
ZQUERY = ( NZC.EQ.-1 )
LAESWAP = .FALSE.
* DSTEMR needs WORK of size 6*N, IWORK of size 3*N.
* In addition, DLARRE needs WORK of size 6*N, IWORK of size 5*N.
@ -502,6 +505,15 @@
ELSE IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
CALL DLAEV2( D(1), E(1), D(2), R1, R2, CS, SN )
END IF
* D/S/LAE2 and D/S/LAEV2 outputs satisfy |R1| >= |R2|. However,
* the following code requires R1 >= R2. Hence, we correct
* the order of R1, R2, CS, SN if R1 < R2 before further processing.
IF( R1.LT.R2 ) THEN
E(2) = R1
R1 = R2
R2 = E(2)
LAESWAP = .TRUE.
ENDIF
IF( ALLEIG.OR.
$ (VALEIG.AND.(R2.GT.WL).AND.
$ (R2.LE.WU)).OR.
@ -509,8 +521,13 @@
M = M+1
W( M ) = R2
IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
Z( 1, M ) = -SN
Z( 2, M ) = CS
IF( LAESWAP ) THEN
Z( 1, M ) = CS
Z( 2, M ) = SN
ELSE
Z( 1, M ) = -SN
Z( 2, M ) = CS
ENDIF
* Note: At most one of SN and CS can be zero.
IF (SN.NE.ZERO) THEN
IF (CS.NE.ZERO) THEN
@ -533,8 +550,13 @@
M = M+1
W( M ) = R1
IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
Z( 1, M ) = CS
Z( 2, M ) = SN
IF( LAESWAP ) THEN
Z( 1, M ) = -SN
Z( 2, M ) = CS
ELSE
Z( 1, M ) = CS
Z( 2, M ) = SN
ENDIF
* Note: At most one of SN and CS can be zero.
IF (SN.NE.ZERO) THEN
IF (CS.NE.ZERO) THEN

36
lapack-netlib/SRC/sstemr.f
View File

@ -303,7 +303,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup realOTHERcomputational
*> \ingroup stemr
*
*> \par Contributors:
* ==================
@ -312,7 +312,8 @@
*> Jim Demmel, University of California, Berkeley, USA \n
*> Inderjit Dhillon, University of Texas, Austin, USA \n
*> Osni Marques, LBNL/NERSC, USA \n
*> Christof Voemel, University of California, Berkeley, USA
*> Christof Voemel, University of California, Berkeley, USA \n
*> Aravindh Krishnamoorthy, FAU, Erlangen, Germany \n
*
* =====================================================================
SUBROUTINE SSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
@ -344,7 +345,8 @@
$ MINRGP = 3.0E-3 )
* ..
* .. Local Scalars ..
LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY
LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY,
$ LAESWAP
INTEGER I, IBEGIN, IEND, IFIRST, IIL, IINDBL, IINDW,
$ IINDWK, IINFO, IINSPL, IIU, ILAST, IN, INDD,
$ INDE2, INDERR, INDGP, INDGRS, INDWRK, ITMP,
@ -378,6 +380,7 @@
*
LQUERY = ( ( LWORK.EQ.-1 ).OR.( LIWORK.EQ.-1 ) )
ZQUERY = ( NZC.EQ.-1 )
LAESWAP = .FALSE.
* SSTEMR needs WORK of size 6*N, IWORK of size 3*N.
* In addition, SLARRE needs WORK of size 6*N, IWORK of size 5*N.
@ -500,6 +503,15 @@
ELSE IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
CALL SLAEV2( D(1), E(1), D(2), R1, R2, CS, SN )
END IF
* D/S/LAE2 and D/S/LAEV2 outputs satisfy |R1| >= |R2|. However,
* the following code requires R1 >= R2. Hence, we correct
* the order of R1, R2, CS, SN if R1 < R2 before further processing.
IF( R1.LT.R2 ) THEN
E(2) = R1
R1 = R2
R2 = E(2)
LAESWAP = .TRUE.
ENDIF
IF( ALLEIG.OR.
$ (VALEIG.AND.(R2.GT.WL).AND.
$ (R2.LE.WU)).OR.
@ -507,8 +519,13 @@
M = M+1
W( M ) = R2
IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
Z( 1, M ) = -SN
Z( 2, M ) = CS
IF( LAESWAP ) THEN
Z( 1, M ) = CS
Z( 2, M ) = SN
ELSE
Z( 1, M ) = -SN
Z( 2, M ) = CS
ENDIF
* Note: At most one of SN and CS can be zero.
IF (SN.NE.ZERO) THEN
IF (CS.NE.ZERO) THEN
@ -531,8 +548,13 @@
M = M+1
W( M ) = R1
IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
Z( 1, M ) = CS
Z( 2, M ) = SN
IF( LAESWAP ) THEN
Z( 1, M ) = -SN
Z( 2, M ) = CS
ELSE
Z( 1, M ) = CS
Z( 2, M ) = SN
ENDIF
* Note: At most one of SN and CS can be zero.
IF (SN.NE.ZERO) THEN
IF (CS.NE.ZERO) THEN

34
lapack-netlib/SRC/zstemr.f
View File

@ -320,7 +320,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup complex16OTHERcomputational
*> \ingroup stemr
*
*> \par Contributors:
* ==================
@ -330,6 +330,7 @@
*> Inderjit Dhillon, University of Texas, Austin, USA \n
*> Osni Marques, LBNL/NERSC, USA \n
*> Christof Voemel, University of California, Berkeley, USA \n
*> Aravindh Krishnamoorthy, FAU, Erlangen, Germany \n
*
* =====================================================================
SUBROUTINE ZSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
@ -361,7 +362,8 @@
$ MINRGP = 1.0D-3 )
* ..
* .. Local Scalars ..
LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY
LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY,
$ LAESWAP
INTEGER I, IBEGIN, IEND, IFIRST, IIL, IINDBL, IINDW,
$ IINDWK, IINFO, IINSPL, IIU, ILAST, IN, INDD,
$ INDE2, INDERR, INDGP, INDGRS, INDWRK, ITMP,
@ -397,6 +399,7 @@
*
LQUERY = ( ( LWORK.EQ.-1 ).OR.( LIWORK.EQ.-1 ) )
ZQUERY = ( NZC.EQ.-1 )
LAESWAP = .FALSE.
* DSTEMR needs WORK of size 6*N, IWORK of size 3*N.
* In addition, DLARRE needs WORK of size 6*N, IWORK of size 5*N.
@ -519,6 +522,15 @@
ELSE IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
CALL DLAEV2( D(1), E(1), D(2), R1, R2, CS, SN )
END IF
* D/S/LAE2 and D/S/LAEV2 outputs satisfy |R1| >= |R2|. However,
* the following code requires R1 >= R2. Hence, we correct
* the order of R1, R2, CS, SN if R1 < R2 before further processing.
IF( R1.LT.R2 ) THEN
E(2) = R1
R1 = R2
R2 = E(2)
LAESWAP = .TRUE.
ENDIF
IF( ALLEIG.OR.
$ (VALEIG.AND.(R2.GT.WL).AND.
$ (R2.LE.WU)).OR.
@ -526,8 +538,13 @@
M = M+1
W( M ) = R2
IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
Z( 1, M ) = -SN
Z( 2, M ) = CS
IF( LAESWAP ) THEN
Z( 1, M ) = CS
Z( 2, M ) = SN
ELSE
Z( 1, M ) = -SN
Z( 2, M ) = CS
ENDIF
* Note: At most one of SN and CS can be zero.
IF (SN.NE.ZERO) THEN
IF (CS.NE.ZERO) THEN
@ -550,8 +567,13 @@
M = M+1
W( M ) = R1
IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
Z( 1, M ) = CS
Z( 2, M ) = SN
IF( LAESWAP ) THEN
Z( 1, M ) = -SN
Z( 2, M ) = CS
ELSE
Z( 1, M ) = CS
Z( 2, M ) = SN
ENDIF
* Note: At most one of SN and CS can be zero.
IF (SN.NE.ZERO) THEN
IF (CS.NE.ZERO) THEN