From 6d3c6b3d719c4fa38f8321e398a8ab142c124f22 Mon Sep 17 00:00:00 2001 From: julie Date: Thu, 22 Oct 2015 04:39:19 +0000 Subject: [PATCH] Fix bug 139 submitted by Christoph Conrads on Oct 6th 2015 "according to the LAPACK documentation, xSTEDC guarantees to return the eigenvalues in ascending order (parameter D on exit). To this end, it sorts the eigenvalues if necessary. If there is only a single subproblem of size n, no sorting algorithm is called (cf. {s,d}tedc.f, line 450). Furthermore, xLAED0 ({s,d}tedc.f:400) does not guarantee to return eigenvalues in ascending order. Thus, xSTEDC may return eigenvalues that are not in ascending order." Applied patch provided by Christoph Conrads: "always sorting the eigenvalues" --- SRC/cstedc.f | 44 +++++++++++++++++++------------------------- SRC/dstedc.f | 50 ++++++++++++++++++++++---------------------------- SRC/sstedc.f | 50 ++++++++++++++++++++++---------------------------- SRC/zstedc.f | 44 +++++++++++++++++++------------------------- 4 files changed, 82 insertions(+), 106 deletions(-) diff --git a/SRC/cstedc.f b/SRC/cstedc.f index 5bf442f..acaae58 100644 --- a/SRC/cstedc.f +++ b/SRC/cstedc.f @@ -453,31 +453,25 @@ * * endwhile * -* If the problem split any number of times, then the eigenvalues -* will not be properly ordered. Here we permute the eigenvalues -* (and the associated eigenvectors) into ascending order. -* - IF( M.NE.N ) THEN -* -* Use Selection Sort to minimize swaps of eigenvectors -* - DO 60 II = 2, N - I = II - 1 - K = I - P = D( I ) - DO 50 J = II, N - IF( D( J ).LT.P ) THEN - K = J - P = D( J ) - END IF - 50 CONTINUE - IF( K.NE.I ) THEN - D( K ) = D( I ) - D( I ) = P - CALL CSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 ) - END IF - 60 CONTINUE - END IF +* +* Use Selection Sort to minimize swaps of eigenvectors +* + DO 60 II = 2, N + I = II - 1 + K = I + P = D( I ) + DO 50 J = II, N + IF( D( J ).LT.P ) THEN + K = J + P = D( J ) + END IF + 50 CONTINUE + IF( K.NE.I ) THEN + D( K ) = D( I ) + D( I ) = P + CALL CSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 ) + END IF + 60 CONTINUE END IF * 70 CONTINUE diff --git a/SRC/dstedc.f b/SRC/dstedc.f index ddfe13e..b97e16b 100644 --- a/SRC/dstedc.f +++ b/SRC/dstedc.f @@ -443,38 +443,32 @@ * * endwhile * -* If the problem split any number of times, then the eigenvalues -* will not be properly ordered. Here we permute the eigenvalues -* (and the associated eigenvectors) into ascending order. + IF( ICOMPZ.EQ.0 ) THEN * - IF( M.NE.N ) THEN - IF( ICOMPZ.EQ.0 ) THEN +* Use Quick Sort * -* Use Quick Sort + CALL DLASRT( 'I', N, D, INFO ) * - CALL DLASRT( 'I', N, D, INFO ) -* - ELSE + ELSE * -* Use Selection Sort to minimize swaps of eigenvectors -* - DO 40 II = 2, N - I = II - 1 - K = I - P = D( I ) - DO 30 J = II, N - IF( D( J ).LT.P ) THEN - K = J - P = D( J ) - END IF - 30 CONTINUE - IF( K.NE.I ) THEN - D( K ) = D( I ) - D( I ) = P - CALL DSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 ) - END IF - 40 CONTINUE - END IF +* Use Selection Sort to minimize swaps of eigenvectors +* + DO 40 II = 2, N + I = II - 1 + K = I + P = D( I ) + DO 30 J = II, N + IF( D( J ).LT.P ) THEN + K = J + P = D( J ) + END IF + 30 CONTINUE + IF( K.NE.I ) THEN + D( K ) = D( I ) + D( I ) = P + CALL DSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 ) + END IF + 40 CONTINUE END IF END IF * diff --git a/SRC/sstedc.f b/SRC/sstedc.f index 841f7e4..f4e3d0b 100644 --- a/SRC/sstedc.f +++ b/SRC/sstedc.f @@ -442,38 +442,32 @@ * * endwhile * -* If the problem split any number of times, then the eigenvalues -* will not be properly ordered. Here we permute the eigenvalues -* (and the associated eigenvectors) into ascending order. + IF( ICOMPZ.EQ.0 ) THEN * - IF( M.NE.N ) THEN - IF( ICOMPZ.EQ.0 ) THEN +* Use Quick Sort * -* Use Quick Sort + CALL SLASRT( 'I', N, D, INFO ) * - CALL SLASRT( 'I', N, D, INFO ) -* - ELSE + ELSE * -* Use Selection Sort to minimize swaps of eigenvectors -* - DO 40 II = 2, N - I = II - 1 - K = I - P = D( I ) - DO 30 J = II, N - IF( D( J ).LT.P ) THEN - K = J - P = D( J ) - END IF - 30 CONTINUE - IF( K.NE.I ) THEN - D( K ) = D( I ) - D( I ) = P - CALL SSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 ) - END IF - 40 CONTINUE - END IF +* Use Selection Sort to minimize swaps of eigenvectors +* + DO 40 II = 2, N + I = II - 1 + K = I + P = D( I ) + DO 30 J = II, N + IF( D( J ).LT.P ) THEN + K = J + P = D( J ) + END IF + 30 CONTINUE + IF( K.NE.I ) THEN + D( K ) = D( I ) + D( I ) = P + CALL SSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 ) + END IF + 40 CONTINUE END IF END IF * diff --git a/SRC/zstedc.f b/SRC/zstedc.f index c0b1edd..37ef718 100644 --- a/SRC/zstedc.f +++ b/SRC/zstedc.f @@ -454,31 +454,25 @@ * * endwhile * -* If the problem split any number of times, then the eigenvalues -* will not be properly ordered. Here we permute the eigenvalues -* (and the associated eigenvectors) into ascending order. -* - IF( M.NE.N ) THEN -* -* Use Selection Sort to minimize swaps of eigenvectors -* - DO 60 II = 2, N - I = II - 1 - K = I - P = D( I ) - DO 50 J = II, N - IF( D( J ).LT.P ) THEN - K = J - P = D( J ) - END IF - 50 CONTINUE - IF( K.NE.I ) THEN - D( K ) = D( I ) - D( I ) = P - CALL ZSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 ) - END IF - 60 CONTINUE - END IF +* +* Use Selection Sort to minimize swaps of eigenvectors +* + DO 60 II = 2, N + I = II - 1 + K = I + P = D( I ) + DO 50 J = II, N + IF( D( J ).LT.P ) THEN + K = J + P = D( J ) + END IF + 50 CONTINUE + IF( K.NE.I ) THEN + D( K ) = D( I ) + D( I ) = P + CALL ZSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 ) + END IF + 60 CONTINUE END IF * 70 CONTINUE -- 2.7.4