diff --git a/lapack-netlib/SRC/cstemr.f b/lapack-netlib/SRC/cstemr.f index d49684db3..9d47450e3 100644 --- a/lapack-netlib/SRC/cstemr.f +++ b/lapack-netlib/SRC/cstemr.f @@ -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 diff --git a/lapack-netlib/SRC/dstemr.f b/lapack-netlib/SRC/dstemr.f index d0c71ddd9..44a33423e 100644 --- a/lapack-netlib/SRC/dstemr.f +++ b/lapack-netlib/SRC/dstemr.f @@ -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 diff --git a/lapack-netlib/SRC/sstemr.f b/lapack-netlib/SRC/sstemr.f index 3a9bbe784..2ed697b69 100644 --- a/lapack-netlib/SRC/sstemr.f +++ b/lapack-netlib/SRC/sstemr.f @@ -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 diff --git a/lapack-netlib/SRC/zstemr.f b/lapack-netlib/SRC/zstemr.f index b034198de..4eaf5ef97 100644 --- a/lapack-netlib/SRC/zstemr.f +++ b/lapack-netlib/SRC/zstemr.f @@ -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