Skip to content

Commit 1363a7c

Browse files
martin-frbgmartin-frbg
authored
Correct the order of eigenvalues/vector for 2x2 matrices (Reference-LAPACK PR 867)
1 parent 4d0b7fb commit 1363a7c

4 files changed

Lines changed: 115 additions & 27 deletions

File tree

‎lapack-netlib/SRC/cstemr.f‎

Lines changed: 29 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -320,7 +320,7 @@
320320
*> \author Univ. of Colorado Denver
321321
*> \author NAG Ltd.
322322
*
323-
*> \ingroup complexOTHERcomputational
323+
*> \ingroup stemr
324324
*
325325
*> \par Contributors:
326326
* ==================
@@ -329,7 +329,8 @@
329329
*> Jim Demmel, University of California, Berkeley, USA \n
330330
*> Inderjit Dhillon, University of Texas, Austin, USA \n
331331
*> Osni Marques, LBNL/NERSC, USA \n
332-
*> Christof Voemel, University of California, Berkeley, USA
332+
*> Christof Voemel, University of California, Berkeley, USA \n
333+
*> Aravindh Krishnamoorthy, FAU, Erlangen, Germany \n
333334
*
334335
* =====================================================================
335336
SUBROUTINE CSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
@@ -361,7 +362,8 @@ SUBROUTINE CSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
361362
$ MINRGP = 3.0E-3 )
362363
* ..
363364
* .. Local Scalars ..
364-
LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY
365+
LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY,
366+
$ LAESWAP
365367
INTEGER I, IBEGIN, IEND, IFIRST, IIL, IINDBL, IINDW,
366368
$ IINDWK, IINFO, IINSPL, IIU, ILAST, IN, INDD,
367369
$ INDE2, INDERR, INDGP, INDGRS, INDWRK, ITMP,
@@ -397,6 +399,7 @@ SUBROUTINE CSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
397399
*
398400
LQUERY = ( ( LWORK.EQ.-1 ).OR.( LIWORK.EQ.-1 ) )
399401
ZQUERY = ( NZC.EQ.-1 )
402+
LAESWAP = .FALSE.
400403

401404
* SSTEMR needs WORK of size 6*N, IWORK of size 3*N.
402405
* In addition, SLARRE needs WORK of size 6*N, IWORK of size 5*N.
@@ -519,15 +522,29 @@ SUBROUTINE CSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
519522
ELSE IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
520523
CALL SLAEV2( D(1), E(1), D(2), R1, R2, CS, SN )
521524
END IF
525+
* D/S/LAE2 and D/S/LAEV2 outputs satisfy |R1| >= |R2|. However,
526+
* the following code requires R1 >= R2. Hence, we correct
527+
* the order of R1, R2, CS, SN if R1 < R2 before further processing.
528+
IF( R1.LT.R2 ) THEN
529+
E(2) = R1
530+
R1 = R2
531+
R2 = E(2)
532+
LAESWAP = .TRUE.
533+
ENDIF
522534
IF( ALLEIG.OR.
523535
$ (VALEIG.AND.(R2.GT.WL).AND.
524536
$ (R2.LE.WU)).OR.
525537
$ (INDEIG.AND.(IIL.EQ.1)) ) THEN
526538
M = M+1
527539
W( M ) = R2
528540
IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
529-
Z( 1, M ) = -SN
530-
Z( 2, M ) = CS
541+
IF( LAESWAP ) THEN
542+
Z( 1, M ) = CS
543+
Z( 2, M ) = SN
544+
ELSE
545+
Z( 1, M ) = -SN
546+
Z( 2, M ) = CS
547+
ENDIF
531548
* Note: At most one of SN and CS can be zero.
532549
IF (SN.NE.ZERO) THEN
533550
IF (CS.NE.ZERO) THEN
@@ -550,8 +567,13 @@ SUBROUTINE CSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
550567
M = M+1
551568
W( M ) = R1
552569
IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
553-
Z( 1, M ) = CS
554-
Z( 2, M ) = SN
570+
IF( LAESWAP ) THEN
571+
Z( 1, M ) = -SN
572+
Z( 2, M ) = CS
573+
ELSE
574+
Z( 1, M ) = CS
575+
Z( 2, M ) = SN
576+
ENDIF
555577
* Note: At most one of SN and CS can be zero.
556578
IF (SN.NE.ZERO) THEN
557579
IF (CS.NE.ZERO) THEN

‎lapack-netlib/SRC/dstemr.f‎

Lines changed: 29 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -303,7 +303,7 @@
303303
*> \author Univ. of Colorado Denver
304304
*> \author NAG Ltd.
305305
*
306-
*> \ingroup doubleOTHERcomputational
306+
*> \ingroup stemr
307307
*
308308
*> \par Contributors:
309309
* ==================
@@ -312,7 +312,8 @@
312312
*> Jim Demmel, University of California, Berkeley, USA \n
313313
*> Inderjit Dhillon, University of Texas, Austin, USA \n
314314
*> Osni Marques, LBNL/NERSC, USA \n
315-
*> Christof Voemel, University of California, Berkeley, USA
315+
*> Christof Voemel, University of California, Berkeley, USA \n
316+
*> Aravindh Krishnamoorthy, FAU, Erlangen, Germany \n
316317
*
317318
* =====================================================================
318319
SUBROUTINE DSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
@@ -344,7 +345,8 @@ SUBROUTINE DSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
344345
$ MINRGP = 1.0D-3 )
345346
* ..
346347
* .. Local Scalars ..
347-
LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY
348+
LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY,
349+
$ LAESWAP
348350
INTEGER I, IBEGIN, IEND, IFIRST, IIL, IINDBL, IINDW,
349351
$ IINDWK, IINFO, IINSPL, IIU, ILAST, IN, INDD,
350352
$ INDE2, INDERR, INDGP, INDGRS, INDWRK, ITMP,
@@ -380,6 +382,7 @@ SUBROUTINE DSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
380382
*
381383
LQUERY = ( ( LWORK.EQ.-1 ).OR.( LIWORK.EQ.-1 ) )
382384
ZQUERY = ( NZC.EQ.-1 )
385+
LAESWAP = .FALSE.
383386

384387
* DSTEMR needs WORK of size 6*N, IWORK of size 3*N.
385388
* In addition, DLARRE needs WORK of size 6*N, IWORK of size 5*N.
@@ -502,15 +505,29 @@ SUBROUTINE DSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
502505
ELSE IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
503506
CALL DLAEV2( D(1), E(1), D(2), R1, R2, CS, SN )
504507
END IF
508+
* D/S/LAE2 and D/S/LAEV2 outputs satisfy |R1| >= |R2|. However,
509+
* the following code requires R1 >= R2. Hence, we correct
510+
* the order of R1, R2, CS, SN if R1 < R2 before further processing.
511+
IF( R1.LT.R2 ) THEN
512+
E(2) = R1
513+
R1 = R2
514+
R2 = E(2)
515+
LAESWAP = .TRUE.
516+
ENDIF
505517
IF( ALLEIG.OR.
506518
$ (VALEIG.AND.(R2.GT.WL).AND.
507519
$ (R2.LE.WU)).OR.
508520
$ (INDEIG.AND.(IIL.EQ.1)) ) THEN
509521
M = M+1
510522
W( M ) = R2
511523
IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
512-
Z( 1, M ) = -SN
513-
Z( 2, M ) = CS
524+
IF( LAESWAP ) THEN
525+
Z( 1, M ) = CS
526+
Z( 2, M ) = SN
527+
ELSE
528+
Z( 1, M ) = -SN
529+
Z( 2, M ) = CS
530+
ENDIF
514531
* Note: At most one of SN and CS can be zero.
515532
IF (SN.NE.ZERO) THEN
516533
IF (CS.NE.ZERO) THEN
@@ -533,8 +550,13 @@ SUBROUTINE DSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
533550
M = M+1
534551
W( M ) = R1
535552
IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
536-
Z( 1, M ) = CS
537-
Z( 2, M ) = SN
553+
IF( LAESWAP ) THEN
554+
Z( 1, M ) = -SN
555+
Z( 2, M ) = CS
556+
ELSE
557+
Z( 1, M ) = CS
558+
Z( 2, M ) = SN
559+
ENDIF
538560
* Note: At most one of SN and CS can be zero.
539561
IF (SN.NE.ZERO) THEN
540562
IF (CS.NE.ZERO) THEN

‎lapack-netlib/SRC/sstemr.f‎

Lines changed: 29 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -303,7 +303,7 @@
303303
*> \author Univ. of Colorado Denver
304304
*> \author NAG Ltd.
305305
*
306-
*> \ingroup realOTHERcomputational
306+
*> \ingroup stemr
307307
*
308308
*> \par Contributors:
309309
* ==================
@@ -312,7 +312,8 @@
312312
*> Jim Demmel, University of California, Berkeley, USA \n
313313
*> Inderjit Dhillon, University of Texas, Austin, USA \n
314314
*> Osni Marques, LBNL/NERSC, USA \n
315-
*> Christof Voemel, University of California, Berkeley, USA
315+
*> Christof Voemel, University of California, Berkeley, USA \n
316+
*> Aravindh Krishnamoorthy, FAU, Erlangen, Germany \n
316317
*
317318
* =====================================================================
318319
SUBROUTINE SSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
@@ -344,7 +345,8 @@ SUBROUTINE SSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
344345
$ MINRGP = 3.0E-3 )
345346
* ..
346347
* .. Local Scalars ..
347-
LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY
348+
LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY,
349+
$ LAESWAP
348350
INTEGER I, IBEGIN, IEND, IFIRST, IIL, IINDBL, IINDW,
349351
$ IINDWK, IINFO, IINSPL, IIU, ILAST, IN, INDD,
350352
$ INDE2, INDERR, INDGP, INDGRS, INDWRK, ITMP,
@@ -378,6 +380,7 @@ SUBROUTINE SSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
378380
*
379381
LQUERY = ( ( LWORK.EQ.-1 ).OR.( LIWORK.EQ.-1 ) )
380382
ZQUERY = ( NZC.EQ.-1 )
383+
LAESWAP = .FALSE.
381384

382385
* SSTEMR needs WORK of size 6*N, IWORK of size 3*N.
383386
* In addition, SLARRE needs WORK of size 6*N, IWORK of size 5*N.
@@ -500,15 +503,29 @@ SUBROUTINE SSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
500503
ELSE IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
501504
CALL SLAEV2( D(1), E(1), D(2), R1, R2, CS, SN )
502505
END IF
506+
* D/S/LAE2 and D/S/LAEV2 outputs satisfy |R1| >= |R2|. However,
507+
* the following code requires R1 >= R2. Hence, we correct
508+
* the order of R1, R2, CS, SN if R1 < R2 before further processing.
509+
IF( R1.LT.R2 ) THEN
510+
E(2) = R1
511+
R1 = R2
512+
R2 = E(2)
513+
LAESWAP = .TRUE.
514+
ENDIF
503515
IF( ALLEIG.OR.
504516
$ (VALEIG.AND.(R2.GT.WL).AND.
505517
$ (R2.LE.WU)).OR.
506518
$ (INDEIG.AND.(IIL.EQ.1)) ) THEN
507519
M = M+1
508520
W( M ) = R2
509521
IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
510-
Z( 1, M ) = -SN
511-
Z( 2, M ) = CS
522+
IF( LAESWAP ) THEN
523+
Z( 1, M ) = CS
524+
Z( 2, M ) = SN
525+
ELSE
526+
Z( 1, M ) = -SN
527+
Z( 2, M ) = CS
528+
ENDIF
512529
* Note: At most one of SN and CS can be zero.
513530
IF (SN.NE.ZERO) THEN
514531
IF (CS.NE.ZERO) THEN
@@ -531,8 +548,13 @@ SUBROUTINE SSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
531548
M = M+1
532549
W( M ) = R1
533550
IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
534-
Z( 1, M ) = CS
535-
Z( 2, M ) = SN
551+
IF( LAESWAP ) THEN
552+
Z( 1, M ) = -SN
553+
Z( 2, M ) = CS
554+
ELSE
555+
Z( 1, M ) = CS
556+
Z( 2, M ) = SN
557+
ENDIF
536558
* Note: At most one of SN and CS can be zero.
537559
IF (SN.NE.ZERO) THEN
538560
IF (CS.NE.ZERO) THEN

‎lapack-netlib/SRC/zstemr.f‎

Lines changed: 28 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -320,7 +320,7 @@
320320
*> \author Univ. of Colorado Denver
321321
*> \author NAG Ltd.
322322
*
323-
*> \ingroup complex16OTHERcomputational
323+
*> \ingroup stemr
324324
*
325325
*> \par Contributors:
326326
* ==================
@@ -330,6 +330,7 @@
330330
*> Inderjit Dhillon, University of Texas, Austin, USA \n
331331
*> Osni Marques, LBNL/NERSC, USA \n
332332
*> Christof Voemel, University of California, Berkeley, USA \n
333+
*> Aravindh Krishnamoorthy, FAU, Erlangen, Germany \n
333334
*
334335
* =====================================================================
335336
SUBROUTINE ZSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
@@ -361,7 +362,8 @@ SUBROUTINE ZSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
361362
$ MINRGP = 1.0D-3 )
362363
* ..
363364
* .. Local Scalars ..
364-
LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY
365+
LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY,
366+
$ LAESWAP
365367
INTEGER I, IBEGIN, IEND, IFIRST, IIL, IINDBL, IINDW,
366368
$ IINDWK, IINFO, IINSPL, IIU, ILAST, IN, INDD,
367369
$ INDE2, INDERR, INDGP, INDGRS, INDWRK, ITMP,
@@ -397,6 +399,7 @@ SUBROUTINE ZSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
397399
*
398400
LQUERY = ( ( LWORK.EQ.-1 ).OR.( LIWORK.EQ.-1 ) )
399401
ZQUERY = ( NZC.EQ.-1 )
402+
LAESWAP = .FALSE.
400403

401404
* DSTEMR needs WORK of size 6*N, IWORK of size 3*N.
402405
* In addition, DLARRE needs WORK of size 6*N, IWORK of size 5*N.
@@ -519,15 +522,29 @@ SUBROUTINE ZSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
519522
ELSE IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
520523
CALL DLAEV2( D(1), E(1), D(2), R1, R2, CS, SN )
521524
END IF
525+
* D/S/LAE2 and D/S/LAEV2 outputs satisfy |R1| >= |R2|. However,
526+
* the following code requires R1 >= R2. Hence, we correct
527+
* the order of R1, R2, CS, SN if R1 < R2 before further processing.
528+
IF( R1.LT.R2 ) THEN
529+
E(2) = R1
530+
R1 = R2
531+
R2 = E(2)
532+
LAESWAP = .TRUE.
533+
ENDIF
522534
IF( ALLEIG.OR.
523535
$ (VALEIG.AND.(R2.GT.WL).AND.
524536
$ (R2.LE.WU)).OR.
525537
$ (INDEIG.AND.(IIL.EQ.1)) ) THEN
526538
M = M+1
527539
W( M ) = R2
528540
IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
529-
Z( 1, M ) = -SN
530-
Z( 2, M ) = CS
541+
IF( LAESWAP ) THEN
542+
Z( 1, M ) = CS
543+
Z( 2, M ) = SN
544+
ELSE
545+
Z( 1, M ) = -SN
546+
Z( 2, M ) = CS
547+
ENDIF
531548
* Note: At most one of SN and CS can be zero.
532549
IF (SN.NE.ZERO) THEN
533550
IF (CS.NE.ZERO) THEN
@@ -550,8 +567,13 @@ SUBROUTINE ZSTEMR( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
550567
M = M+1
551568
W( M ) = R1
552569
IF( WANTZ.AND.(.NOT.ZQUERY) ) THEN
553-
Z( 1, M ) = CS
554-
Z( 2, M ) = SN
570+
IF( LAESWAP ) THEN
571+
Z( 1, M ) = -SN
572+
Z( 2, M ) = CS
573+
ELSE
574+
Z( 1, M ) = CS
575+
Z( 2, M ) = SN
576+
ENDIF
555577
* Note: At most one of SN and CS can be zero.
556578
IF (SN.NE.ZERO) THEN
557579
IF (CS.NE.ZERO) THEN

0 commit comments

Comments
 (0)