Skip to content

Commit 6f039cb

Browse files
#826: Eigenvectors bug in dstemr.f
1 parent 3a7690c commit 6f039cb

File tree

1 file changed

+19
-11
lines changed

1 file changed

+19
-11
lines changed

SRC/dstemr.f

Lines changed: 19 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -344,7 +344,8 @@ SUBROUTINE DSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
344344
$ MINRGP = 1.0D-3 )
345345
* ..
346346
* .. Local Scalars ..
347-
LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY
347+
LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY,
348+
$ DLAESWAP
348349
INTEGER I, IBEGIN, IEND, IFIRST, IIL, IINDBL, IINDW,
349350
$ IINDWK, IINFO, IINSPL, IIU, ILAST, IN, INDD,
350351
$ INDE2, INDERR, INDGP, INDGRS, INDWRK, ITMP,
@@ -380,6 +381,7 @@ SUBROUTINE DSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
380381
*
381382
LQUERY = ( ( LWORK.EQ.-1 ).OR.( LIWORK.EQ.-1 ) )
382383
ZQUERY = ( NZC.EQ.-1 )
384+
DLAESWAP = .FALSE.
383385

384386
* DSTEMR needs WORK of size 6*N, IWORK of size 3*N.
385387
* In addition, DLARRE needs WORK of size 6*N, IWORK of size 5*N.
@@ -505,15 +507,11 @@ SUBROUTINE DSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
505507
* DLAE2 and DLAEV2 outputs satisfy |R1| >= |R2|. However,
506508
* the following DSTEMR requires R1 >= R2. Hence, we correct
507509
* the order of R1, R2, CS, SN if R1 < R2 before further processing.
508-
IF(R1.LT.R2) THEN
510+
IF( R1.LT.R2 ) THEN
509511
E(2) = R1
510512
R1 = R2
511513
R2 = E(2)
512-
IF(WANTZ.AND.(.NOT.ZQUERY)) THEN
513-
E(2) = CS
514-
CS = -SN
515-
SN = E(2)
516-
ENDIF
514+
DLAESWAP = .TRUE.
517515
ENDIF
518516
IF( ALLEIG.OR.
519517
$ (VALEIG.AND.(R2.GT.WL).AND.
@@ -522,8 +520,13 @@ SUBROUTINE DSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
522520
M = M+1
523521
W( M ) = R2
524522
IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
525-
Z( 1, M ) = -SN
526-
Z( 2, M ) = CS
523+
IF( DLAESWAP ) THEN
524+
Z( 1, M ) = CS
525+
Z( 2, M ) = SN
526+
ELSE
527+
Z( 1, M ) = -SN
528+
Z( 2, M ) = CS
529+
ENDIF
527530
* Note: At most one of SN and CS can be zero.
528531
IF (SN.NE.ZERO) THEN
529532
IF (CS.NE.ZERO) THEN
@@ -546,8 +549,13 @@ SUBROUTINE DSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
546549
M = M+1
547550
W( M ) = R1
548551
IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
549-
Z( 1, M ) = CS
550-
Z( 2, M ) = SN
552+
IF( DLAESWAP ) THEN
553+
Z( 1, M ) = -SN
554+
Z( 2, M ) = CS
555+
ELSE
556+
Z( 1, M ) = CS
557+
Z( 2, M ) = SN
558+
ENDIF
551559
* Note: At most one of SN and CS can be zero.
552560
IF (SN.NE.ZERO) THEN
553561
IF (CS.NE.ZERO) THEN

0 commit comments

Comments
 (0)