From 06f432d14d1a4255929e35ffd4ee9d8cabf07ced Mon Sep 17 00:00:00 2001 From: igor175 Date: Tue, 11 Aug 2015 22:27:27 +0000 Subject: [PATCH] Fixed BUG number 123, that is testing of 'rook' routines, specifically TEST 4 for UPLO='U' case that test bounds of block diagonal matrices. TEST 4 wasfailing for UPLO='U', since 2-by-2 was passed incorrectly to the -EVX routine. Also, during the fix the TEST 4 for both UPLO='U' and 'L' was modified. Instead of computing the ratio of eigenvalues for 2-by-2 matrices, using the -EVX routines, now we compute the ratio of singular values using *GESVD routines. Affected test routines: TESTING/LIN/schksy_rook.f TESTING/LIN/dchksy_rook.f TESTING/LIN/cchksy_rook.f TESTING/LIN/zchksy_rook.f TESTING/LIN/cchkhe_rook.f TESTING/LIN/zchkhe_rook.f --- TESTING/LIN/cchkhe_rook.f | 64 +++++++++++++++++++++------------------ TESTING/LIN/cchksy_rook.f | 54 +++++++++++++++------------------ TESTING/LIN/dchksy_rook.f | 58 +++++++++++++++++++---------------- TESTING/LIN/schksy_rook.f | 59 ++++++++++++++++++++---------------- TESTING/LIN/zchkhe_rook.f | 64 +++++++++++++++++++++------------------ TESTING/LIN/zchksy_rook.f | 54 +++++++++++++++------------------ 6 files changed, 183 insertions(+), 170 deletions(-) diff --git a/TESTING/LIN/cchkhe_rook.f b/TESTING/LIN/cchkhe_rook.f index 7d7ab8e9..a58b590a 100644 --- a/TESTING/LIN/cchkhe_rook.f +++ b/TESTING/LIN/cchkhe_rook.f @@ -221,20 +221,20 @@ CHARACTER UPLOS( 2 ) INTEGER ISEED( 4 ), ISEEDY( 4 ), IDUMMY( 1 ) REAL RESULT( NTESTS ) - COMPLEX CDUMMY( 1 ) + COMPLEX BLOCK( 2, 2 ), CDUMMY( 1 ) * .. * .. External Functions .. REAL CLANGE, CLANHE, SGET06 EXTERNAL CLANGE, CLANHE, SGET06 * .. * .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, CERRHE, CHEEVX, CGET04, + EXTERNAL ALAERH, ALAHD, ALASUM, CERRHE, CGESVD, CGET04, $ CLACPY, CLARHS, CLATB4, CLATMS, CPOT02, $ CPOT03, CHECON_ROOK, CHET01_ROOK, CHETRF_ROOK, $ CHETRI_ROOK, CHETRS_ROOK, XLAENV * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, SQRT + INTRINSIC MAX, MIN, SQRT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -607,7 +607,8 @@ * * *+ TEST 4 -* Compute largest 2-Norm of 2-by-2 diag blocks +* Compute largest 2-Norm (condition number) +* of 2-by-2 diag blocks * RESULT( 4 ) = ZERO STEMP = ZERO @@ -627,26 +628,28 @@ * IF( IWORK( K ).LT.ZERO ) THEN * -* Get the two eigenvalues of a 2-by-2 block, -* store them in WORK array +* Get the two singular values +* (real and non-negative) of a 2-by-2 block, +* store them in RWORK array * - CALL CHEEVX( 'N', 'A', UPLO, 2, - $ AINV( ( K-2 )*LDA+K-1 ), LDA,STEMP, - $ STEMP, ITEMP, ITEMP, ZERO, ITEMP, - $ RWORK, CDUMMY, 1, WORK, 16, - $ RWORK( 3 ), IWORK( N+1 ), IDUMMY, - $ INFO ) + BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 ) + BLOCK( 1, 2 ) = AFAC( (K-1)*LDA+K-1 ) + BLOCK( 2, 1 ) = BLOCK( 1, 2 ) + BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K ) * - LAM_MAX = MAX( ABS( RWORK( 1 ) ), - $ ABS( RWORK( 2 ) ) ) - LAM_MIN = MIN( ABS( RWORK( 1 ) ), - $ ABS( RWORK( 2 ) ) ) + CALL CGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK, + $ CDUMMY, 1, CDUMMY, 1, + $ WORK, 6, RWORK( 3 ), INFO ) +* +* + LAM_MAX = RWORK( 1 ) + LAM_MIN = RWORK( 2 ) * STEMP = LAM_MAX / LAM_MIN * * STEMP should be bounded by CONST * - STEMP = ABS( STEMP ) - CONST + THRESH + STEMP = STEMP - CONST + THRESH IF( STEMP.GT.RESULT( 4 ) ) $ RESULT( 4 ) = STEMP K = K - 1 @@ -669,26 +672,27 @@ * IF( IWORK( K ).LT.ZERO ) THEN * -* Get the two eigenvalues of a 2-by-2 block, -* store them in WORK array +* Get the two singular values +* (real and non-negative) of a 2-by-2 block, +* store them in RWORK array +* + BLOCK( 1, 1 ) = AFAC( ( K-1 )*LDA+K ) + BLOCK( 2, 1 ) = AFAC( ( K-1 )*LDA+K+1 ) + BLOCK( 1, 2 ) = BLOCK( 2, 1 ) + BLOCK( 2, 2 ) = AFAC( K*LDA+K+1 ) * - CALL CHEEVX( 'N', 'A', UPLO, 2, - $ AINV( ( K-1 )*LDA+K ), LDA, STEMP, - $ STEMP, ITEMP, ITEMP, ZERO, ITEMP, - $ RWORK, CDUMMY, 1, WORK, 16, - $ RWORK( 3 ), IWORK( N+1 ), IDUMMY, - $ INFO ) + CALL CGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK, + $ CDUMMY, 1, CDUMMY, 1, + $ WORK, 6, RWORK(3), INFO ) * - LAM_MAX = MAX( ABS( RWORK( 1 ) ), - $ ABS( RWORK( 2 ) ) ) - LAM_MIN = MIN( ABS( RWORK( 1 ) ), - $ ABS( RWORK( 2 ) ) ) + LAM_MAX = RWORK( 1 ) + LAM_MIN = RWORK( 2 ) * STEMP = LAM_MAX / LAM_MIN * * STEMP should be bounded by CONST * - STEMP = ABS( STEMP ) - CONST + THRESH + STEMP = STEMP - CONST + THRESH IF( STEMP.GT.RESULT( 4 ) ) $ RESULT( 4 ) = STEMP K = K + 1 diff --git a/TESTING/LIN/cchksy_rook.f b/TESTING/LIN/cchksy_rook.f index cafd4d93..9b77efae 100644 --- a/TESTING/LIN/cchksy_rook.f +++ b/TESTING/LIN/cchksy_rook.f @@ -228,13 +228,13 @@ EXTERNAL CLANGE, CLANSY, SGET06 * .. * .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, CERRSY, CGEEVX, CGET04, + EXTERNAL ALAERH, ALAHD, ALASUM, CERRSY, CGESVD, CGET04, $ CLACPY, CLARHS, CLATB4, CLATMS, CLATSY, CSYT02, $ CSYT03, CSYCON_ROOK, CSYT01_ROOK, CSYTRF_ROOK, $ CSYTRI_ROOK, CSYTRS_ROOK, XLAENV * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, SQRT + INTRINSIC MAX, MIN, SQRT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -619,7 +619,8 @@ * * *+ TEST 4 -* Compute largest 2-Norm of 2-by-2 diag blocks +* Compute largest 2-Norm (condition number) +* of 2-by-2 diag blocks * RESULT( 4 ) = ZERO STEMP = ZERO @@ -638,30 +639,28 @@ * IF( IWORK( K ).LT.ZERO ) THEN * -* Get the two eigenvalues of a 2-by-2 block, -* store them in WORK array +* Get the two singular values +* (real and non-negative) of a 2-by-2 block, +* store them in RWORK array * BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 ) - BLOCK( 2, 1 ) = AFAC( ( K-2 )*LDA+K ) - BLOCK( 1, 2 ) = BLOCK( 2, 1 ) + BLOCK( 1, 2 ) = AFAC( (K-1)*LDA+K-1 ) + BLOCK( 2, 1 ) = BLOCK( 1, 2 ) BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K ) * - CALL CGEEVX( 'N', 'N', 'N', 'N', 2, BLOCK, - $ 2, WORK, CDUMMY, 1, CDUMMY, 1, - $ ITEMP, ITEMP2, RWORK, STEMP, - $ RWORK( 3 ), RWORK( 5 ), WORK( 3 ), - $ 4, RWORK( 7 ), INFO ) + CALL CGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK, + $ CDUMMY, 1, CDUMMY, 1, + $ WORK, 6, RWORK( 3 ), INFO ) +* * - LAM_MAX = MAX( ABS( WORK( 1 ) ), - $ ABS( WORK( 2 ) ) ) - LAM_MIN = MIN( ABS( WORK( 1 ) ), - $ ABS( WORK( 2 ) ) ) + LAM_MAX = RWORK( 1 ) + LAM_MIN = RWORK( 2 ) * STEMP = LAM_MAX / LAM_MIN * * STEMP should be bounded by CONST * - STEMP = ABS( STEMP ) - CONST + THRESH + STEMP = STEMP - CONST + THRESH IF( STEMP.GT.RESULT( 4 ) ) $ RESULT( 4 ) = STEMP K = K - 1 @@ -684,30 +683,27 @@ * IF( IWORK( K ).LT.ZERO ) THEN * -* Get the two eigenvalues of a 2-by-2 block, -* store them in WORK array +* Get the two singular values +* (real and non-negative) of a 2-by-2 block, +* store them in RWORK array * BLOCK( 1, 1 ) = AFAC( ( K-1 )*LDA+K ) BLOCK( 2, 1 ) = AFAC( ( K-1 )*LDA+K+1 ) BLOCK( 1, 2 ) = BLOCK( 2, 1 ) BLOCK( 2, 2 ) = AFAC( K*LDA+K+1 ) * - CALL CGEEVX( 'N', 'N', 'N', 'N', 2, BLOCK, - $ 2, WORK, CDUMMY, 1, CDUMMY, 1, - $ ITEMP, ITEMP2, RWORK, STEMP, - $ RWORK( 3 ), RWORK( 5 ), WORK( 3 ), - $ 4, RWORK( 7 ), INFO ) + CALL CGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK, + $ CDUMMY, 1, CDUMMY, 1, + $ WORK, 6, RWORK(3), INFO ) * - LAM_MAX = MAX( ABS( WORK( 1 ) ), - $ ABS( WORK( 2 ) ) ) - LAM_MIN = MIN( ABS( WORK( 1 ) ), - $ ABS( WORK( 2 ) ) ) + LAM_MAX = RWORK( 1 ) + LAM_MIN = RWORK( 2 ) * STEMP = LAM_MAX / LAM_MIN * * STEMP should be bounded by CONST * - STEMP = ABS( STEMP ) - CONST + THRESH + STEMP = STEMP - CONST + THRESH IF( STEMP.GT.RESULT( 4 ) ) $ RESULT( 4 ) = STEMP K = K + 1 diff --git a/TESTING/LIN/dchksy_rook.f b/TESTING/LIN/dchksy_rook.f index e7cea27f..4e3ec5bf 100644 --- a/TESTING/LIN/dchksy_rook.f +++ b/TESTING/LIN/dchksy_rook.f @@ -214,7 +214,7 @@ * .. Local Arrays .. CHARACTER UPLOS( 2 ) INTEGER IDUMMY( 1 ), ISEED( 4 ), ISEEDY( 4 ) - DOUBLE PRECISION DDUMMY( 1 ), RESULT( NTESTS ) + DOUBLE PRECISION BLOCK( 2, 2 ), DDUMMY( 1 ), RESULT( NTESTS ) * .. * .. External Functions .. DOUBLE PRECISION DGET06, DLANGE, DLANSY @@ -222,12 +222,12 @@ * .. * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASUM, DERRSY, DGET04, DLACPY, - $ DLARHS, DLATB4, DLATMS, DPOT02, DPOT03, DSYEVX, + $ DLARHS, DLATB4, DLATMS, DPOT02, DPOT03, DGESVD, $ DSYCON_ROOK, DSYT01_ROOK, DSYTRF_ROOK, $ DSYTRI_ROOK, DSYTRS_ROOK, XLAENV * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, SQRT + INTRINSIC MAX, MIN, SQRT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -599,7 +599,8 @@ * * *+ TEST 4 -* Compute largest 2-Norm of 2-by-2 diag blocks +* Compute largest 2-Norm (condition number) +* of 2-by-2 diag blocks * RESULT( 4 ) = ZERO DTEMP = ZERO @@ -618,25 +619,27 @@ * IF( IWORK( K ).LT.ZERO ) THEN * -* Get the two eigenvalues of a 2-by-2 block, +* Get the two singular values +* (real and non-negative) of a 2-by-2 block, * store them in RWORK array * - CALL DSYEVX( 'N', 'A', UPLO, 2, - $ AINV( ( K-2 )*LDA+K-1 ), LDA, DTEMP, - $ DTEMP, ITEMP, ITEMP, ZERO, ITEMP, - $ RWORK, DDUMMY, 1, WORK, 16, - $ IWORK( N+1 ), IDUMMY, INFO ) + BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 ) + BLOCK( 1, 2 ) = AFAC( (K-1)*LDA+K-1 ) + BLOCK( 2, 1 ) = BLOCK( 1, 2 ) + BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K ) * - LAM_MAX = MAX( ABS( RWORK( 1 ) ), - $ ABS( RWORK( 2 ) ) ) - LAM_MIN = MIN( ABS( RWORK( 1 ) ), - $ ABS( RWORK( 2 ) ) ) + CALL DGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK, + $ DDUMMY, 1, DDUMMY, 1, + $ WORK, 10, INFO ) +* + LAM_MAX = RWORK( 1 ) + LAM_MIN = RWORK( 2 ) * DTEMP = LAM_MAX / LAM_MIN * * DTEMP should be bounded by CONST * - DTEMP = ABS( DTEMP ) - CONST + THRESH + DTEMP = DTEMP - CONST + THRESH IF( DTEMP.GT.RESULT( 4 ) ) $ RESULT( 4 ) = DTEMP K = K - 1 @@ -659,25 +662,28 @@ * IF( IWORK( K ).LT.ZERO ) THEN * -* Get the two eigenvalues of a 2-by-2 block, +* Get the two singular values +* (real and non-negative) of a 2-by-2 block, * store them in RWORK array * - CALL DSYEVX( 'N', 'A', UPLO, 2, - $ AINV( ( K-1 )*LDA+K ), LDA, DTEMP, - $ DTEMP, ITEMP, ITEMP, ZERO, ITEMP, - $ RWORK, DDUMMY, 1, WORK, 16, - $ IWORK( N+1 ), IDUMMY, INFO ) + BLOCK( 1, 1 ) = AFAC( ( K-1 )*LDA+K ) + BLOCK( 2, 1 ) = AFAC( ( K-1 )*LDA+K+1 ) + BLOCK( 1, 2 ) = BLOCK( 2, 1 ) + BLOCK( 2, 2 ) = AFAC( K*LDA+K+1 ) +* + CALL DGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK, + $ DDUMMY, 1, DDUMMY, 1, + $ WORK, 10, INFO ) +* * - LAM_MAX = MAX( ABS( RWORK( 1 ) ), - $ ABS( RWORK( 2 ) ) ) - LAM_MIN = MIN( ABS( RWORK( 1 ) ), - $ ABS( RWORK( 2 ) ) ) + LAM_MAX = RWORK( 1 ) + LAM_MIN = RWORK( 2 ) * DTEMP = LAM_MAX / LAM_MIN * * DTEMP should be bounded by CONST * - DTEMP = ABS( DTEMP ) - CONST + THRESH + DTEMP = DTEMP - CONST + THRESH IF( DTEMP.GT.RESULT( 4 ) ) $ RESULT( 4 ) = DTEMP K = K + 1 diff --git a/TESTING/LIN/schksy_rook.f b/TESTING/LIN/schksy_rook.f index 23a84cd1..38cb63bb 100644 --- a/TESTING/LIN/schksy_rook.f +++ b/TESTING/LIN/schksy_rook.f @@ -214,7 +214,7 @@ * .. Local Arrays .. CHARACTER UPLOS( 2 ) INTEGER IDUMMY( 1 ), ISEED( 4 ), ISEEDY( 4 ) - REAL RESULT( NTESTS ), SDUMMY( 1 ) + REAL BLOCK( 2, 2 ), RESULT( NTESTS ), SDUMMY( 1 ) * .. * .. External Functions .. REAL SGET06, SLANGE, SLANSY @@ -222,12 +222,12 @@ * .. * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASUM, SERRSY, SGET04, SLACPY, - $ SLARHS, SLATB4, SLATMS, SPOT02, SPOT03, SSYEVX, + $ SLARHS, SLATB4, SLATMS, SPOT02, SPOT03, SGESVD, $ SSYCON_ROOK, SSYT01_ROOK, SSYTRF_ROOK, $ SSYTRI_ROOK, SSYTRS_ROOK, XLAENV * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, SQRT + INTRINSIC MAX, MIN, SQRT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -599,7 +599,8 @@ * * *+ TEST 4 -* Compute largest 2-Norm of 2-by-2 diag blocks +* Compute largest 2-Norm (condition number) +* of 2-by-2 diag blocks * RESULT( 4 ) = ZERO STEMP = ZERO @@ -618,25 +619,28 @@ * IF( IWORK( K ).LT.ZERO ) THEN * -* Get the two eigenvalues of a 2-by-2 block, +* Get the two singular values +* (real and non-negative) of a 2-by-2 block, * store them in RWORK array * - CALL SSYEVX( 'N', 'A', UPLO, 2, - $ AINV( ( K-2 )*LDA+K-1 ), LDA, STEMP, - $ STEMP, ITEMP, ITEMP, ZERO, ITEMP, - $ RWORK, SDUMMY, 1, WORK, 16, - $ IWORK( N+1 ), IDUMMY, INFO ) + BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 ) + BLOCK( 1, 2 ) = AFAC( (K-1)*LDA+K-1 ) + BLOCK( 2, 1 ) = BLOCK( 1, 2 ) + BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K ) * - LAM_MAX = MAX( ABS( RWORK( 1 ) ), - $ ABS( RWORK( 2 ) ) ) - LAM_MIN = MIN( ABS( RWORK( 1 ) ), - $ ABS( RWORK( 2 ) ) ) + CALL SGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK, + $ SDUMMY, 1, SDUMMY, 1, + $ WORK, 10, INFO ) +* +* + LAM_MAX = RWORK( 1 ) + LAM_MIN = RWORK( 2 ) * STEMP = LAM_MAX / LAM_MIN * * STEMP should be bounded by CONST * - STEMP = ABS( STEMP ) - CONST + THRESH + STEMP = STEMP - CONST + THRESH IF( STEMP.GT.RESULT( 4 ) ) $ RESULT( 4 ) = STEMP K = K - 1 @@ -659,25 +663,28 @@ * IF( IWORK( K ).LT.ZERO ) THEN * -* Get the two eigenvalues of a 2-by-2 block, +* Get the two singular values +* (real and non-negative) of a 2-by-2 block, * store them in RWORK array * - CALL SSYEVX( 'N', 'A', UPLO, 2, - $ AINV( ( K-1 )*LDA+K ), LDA, STEMP, - $ STEMP, ITEMP, ITEMP, ZERO, ITEMP, - $ RWORK, SDUMMY, 1, WORK, 16, - $ IWORK( N+1 ), IDUMMY, INFO ) + BLOCK( 1, 1 ) = AFAC( ( K-1 )*LDA+K ) + BLOCK( 2, 1 ) = AFAC( ( K-1 )*LDA+K+1 ) + BLOCK( 1, 2 ) = BLOCK( 2, 1 ) + BLOCK( 2, 2 ) = AFAC( K*LDA+K+1 ) +* + CALL SGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK, + $ SDUMMY, 1, SDUMMY, 1, + $ WORK, 10, INFO ) +* * - LAM_MAX = MAX( ABS( RWORK( 1 ) ), - $ ABS( RWORK( 2 ) ) ) - LAM_MIN = MIN( ABS( RWORK( 1 ) ), - $ ABS( RWORK( 2 ) ) ) + LAM_MAX = RWORK( 1 ) + LAM_MIN = RWORK( 2 ) * STEMP = LAM_MAX / LAM_MIN * * STEMP should be bounded by CONST * - STEMP = ABS( STEMP ) - CONST + THRESH + STEMP = STEMP - CONST + THRESH IF( STEMP.GT.RESULT( 4 ) ) $ RESULT( 4 ) = STEMP K = K + 1 diff --git a/TESTING/LIN/zchkhe_rook.f b/TESTING/LIN/zchkhe_rook.f index 0ec8def2..decebb9b 100644 --- a/TESTING/LIN/zchkhe_rook.f +++ b/TESTING/LIN/zchkhe_rook.f @@ -221,20 +221,20 @@ CHARACTER UPLOS( 2 ) INTEGER ISEED( 4 ), ISEEDY( 4 ), IDUMMY( 1 ) DOUBLE PRECISION RESULT( NTESTS ) - COMPLEX*16 CDUMMY( 1 ) + COMPLEX*16 BLOCK( 2, 2 ), ZDUMMY( 1 ) * .. * .. External Functions .. DOUBLE PRECISION ZLANGE, ZLANHE, DGET06 EXTERNAL ZLANGE, ZLANHE, DGET06 * .. * .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, ZERRHE, ZHEEVX, ZGET04, + EXTERNAL ALAERH, ALAHD, ALASUM, ZERRHE, ZGESVD, ZGET04, $ ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZPOT02, $ ZPOT03, ZHECON_ROOK, ZHET01_ROOK, ZHETRF_ROOK, $ ZHETRI_ROOK, ZHETRS_ROOK, XLAENV * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, SQRT + INTRINSIC MAX, MIN, SQRT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -607,7 +607,8 @@ * * *+ TEST 4 -* Compute largest 2-Norm of 2-by-2 diag blocks +* Compute largest 2-Norm (condition number) +* of 2-by-2 diag blocks * RESULT( 4 ) = ZERO DTEMP = ZERO @@ -627,26 +628,28 @@ * IF( IWORK( K ).LT.ZERO ) THEN * -* Get the two eigenvalues of a 2-by-2 block, -* store them in WORK array +* Get the two singular values +* (real and non-negative) of a 2-by-2 block, +* store them in RWORK array * - CALL ZHEEVX( 'N', 'A', UPLO, 2, - $ AINV( ( K-2 )*LDA+K-1 ), LDA,DTEMP, - $ DTEMP, ITEMP, ITEMP, ZERO, ITEMP, - $ RWORK, CDUMMY, 1, WORK, 16, - $ RWORK( 3 ), IWORK( N+1 ), IDUMMY, - $ INFO ) + BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 ) + BLOCK( 1, 2 ) = AFAC( (K-1)*LDA+K-1 ) + BLOCK( 2, 1 ) = BLOCK( 1, 2 ) + BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K ) * - LAM_MAX = MAX( ABS( RWORK( 1 ) ), - $ ABS( RWORK( 2 ) ) ) - LAM_MIN = MIN( ABS( RWORK( 1 ) ), - $ ABS( RWORK( 2 ) ) ) + CALL ZGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK, + $ ZDUMMY, 1, ZDUMMY, 1, + $ WORK, 6, RWORK( 3 ), INFO ) +* +* + LAM_MAX = RWORK( 1 ) + LAM_MIN = RWORK( 2 ) * DTEMP = LAM_MAX / LAM_MIN * * DTEMP should be bounded by CONST * - DTEMP = ABS( DTEMP ) - CONST + THRESH + DTEMP = DTEMP - CONST + THRESH IF( DTEMP.GT.RESULT( 4 ) ) $ RESULT( 4 ) = DTEMP K = K - 1 @@ -669,26 +672,27 @@ * IF( IWORK( K ).LT.ZERO ) THEN * -* Get the two eigenvalues of a 2-by-2 block, -* store them in WORK array +* Get the two singular values +* (real and non-negative) of a 2-by-2 block, +* store them in RWORK array +* + BLOCK( 1, 1 ) = AFAC( ( K-1 )*LDA+K ) + BLOCK( 2, 1 ) = AFAC( ( K-1 )*LDA+K+1 ) + BLOCK( 1, 2 ) = BLOCK( 2, 1 ) + BLOCK( 2, 2 ) = AFAC( K*LDA+K+1 ) * - CALL ZHEEVX( 'N', 'A', UPLO, 2, - $ AINV( ( K-1 )*LDA+K ), LDA, DTEMP, - $ DTEMP, ITEMP, ITEMP, ZERO, ITEMP, - $ RWORK, CDUMMY, 1, WORK, 16, - $ RWORK( 3 ), IWORK( N+1 ), IDUMMY, - $ INFO ) + CALL ZGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK, + $ ZDUMMY, 1, ZDUMMY, 1, + $ WORK, 6, RWORK(3), INFO ) * - LAM_MAX = MAX( ABS( RWORK( 1 ) ), - $ ABS( RWORK( 2 ) ) ) - LAM_MIN = MIN( ABS( RWORK( 1 ) ), - $ ABS( RWORK( 2 ) ) ) + LAM_MAX = RWORK( 1 ) + LAM_MIN = RWORK( 2 ) * DTEMP = LAM_MAX / LAM_MIN * * DTEMP should be bounded by CONST * - DTEMP = ABS( DTEMP ) - CONST + THRESH + DTEMP = DTEMP - CONST + THRESH IF( DTEMP.GT.RESULT( 4 ) ) $ RESULT( 4 ) = DTEMP K = K + 1 diff --git a/TESTING/LIN/zchksy_rook.f b/TESTING/LIN/zchksy_rook.f index 3b93b6fe..5eb83ebf 100644 --- a/TESTING/LIN/zchksy_rook.f +++ b/TESTING/LIN/zchksy_rook.f @@ -228,13 +228,13 @@ EXTERNAL DGET06, ZLANGE, ZLANSY * .. * .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, ZERRSY, ZGEEVX, ZGET04, + EXTERNAL ALAERH, ALAHD, ALASUM, ZERRSY, ZGESVD, ZGET04, $ ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZLATSY,ZSYT02, $ ZSYT03, ZSYCON_ROOK, ZSYT01_ROOK, ZSYTRF_ROOK, $ ZSYTRI_ROOK, ZSYTRS_ROOK, XLAENV * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, SQRT + INTRINSIC MAX, MIN, SQRT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -619,7 +619,8 @@ * * *+ TEST 4 -* Compute largest 2-Norm of 2-by-2 diag blocks +* Compute largest 2-Norm (condition number) +* of 2-by-2 diag blocks * RESULT( 4 ) = ZERO DTEMP = ZERO @@ -638,30 +639,28 @@ * IF( IWORK( K ).LT.ZERO ) THEN * -* Get the two eigenvalues of a 2-by-2 block, -* store them in WORK array +* Get the two singular values +* (real and non-negative) of a 2-by-2 block, +* store them in RWORK array * BLOCK( 1, 1 ) = AFAC( ( K-2 )*LDA+K-1 ) - BLOCK( 2, 1 ) = AFAC( ( K-2 )*LDA+K ) - BLOCK( 1, 2 ) = BLOCK( 2, 1 ) + BLOCK( 1, 2 ) = AFAC( (K-1)*LDA+K-1 ) + BLOCK( 2, 1 ) = BLOCK( 1, 2 ) BLOCK( 2, 2 ) = AFAC( (K-1)*LDA+K ) * - CALL ZGEEVX( 'N', 'N', 'N', 'N', 2, BLOCK, - $ 2, WORK, ZDUMMY, 1, ZDUMMY, 1, - $ ITEMP, ITEMP2, RWORK, DTEMP, - $ RWORK( 3 ), RWORK( 5 ), WORK( 3 ), - $ 4, RWORK( 7 ), INFO ) + CALL ZGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK, + $ ZDUMMY, 1, ZDUMMY, 1, + $ WORK, 6, RWORK( 3 ), INFO ) +* * - LAM_MAX = MAX( ABS( WORK( 1 ) ), - $ ABS( WORK( 2 ) ) ) - LAM_MIN = MIN( ABS( WORK( 1 ) ), - $ ABS( WORK( 2 ) ) ) + LAM_MAX = RWORK( 1 ) + LAM_MIN = RWORK( 2 ) * DTEMP = LAM_MAX / LAM_MIN * * DTEMP should be bounded by CONST * - DTEMP = ABS( DTEMP ) - CONST + THRESH + DTEMP = DTEMP - CONST + THRESH IF( DTEMP.GT.RESULT( 4 ) ) $ RESULT( 4 ) = DTEMP K = K - 1 @@ -684,30 +683,27 @@ * IF( IWORK( K ).LT.ZERO ) THEN * -* Get the two eigenvalues of a 2-by-2 block, -* store them in WORK array +* Get the two singular values +* (real and non-negative) of a 2-by-2 block, +* store them in RWORK array * BLOCK( 1, 1 ) = AFAC( ( K-1 )*LDA+K ) BLOCK( 2, 1 ) = AFAC( ( K-1 )*LDA+K+1 ) BLOCK( 1, 2 ) = BLOCK( 2, 1 ) BLOCK( 2, 2 ) = AFAC( K*LDA+K+1 ) * - CALL ZGEEVX( 'N', 'N', 'N', 'N', 2, BLOCK, - $ 2, WORK, ZDUMMY, 1, ZDUMMY, 1, - $ ITEMP, ITEMP2, RWORK, DTEMP, - $ RWORK( 3 ), RWORK( 5 ), WORK( 3 ), - $ 4, RWORK( 7 ), INFO ) + CALL ZGESVD( 'N', 'N', 2, 2, BLOCK, 2, RWORK, + $ ZDUMMY, 1, ZDUMMY, 1, + $ WORK, 6, RWORK(3), INFO ) * - LAM_MAX = MAX( ABS( WORK( 1 ) ), - $ ABS( WORK( 2 ) ) ) - LAM_MIN = MIN( ABS( WORK( 1 ) ), - $ ABS( WORK( 2 ) ) ) + LAM_MAX = RWORK( 1 ) + LAM_MIN = RWORK( 2 ) * DTEMP = LAM_MAX / LAM_MIN * * DTEMP should be bounded by CONST * - DTEMP = ABS( DTEMP ) - CONST + THRESH + DTEMP = DTEMP - CONST + THRESH IF( DTEMP.GT.RESULT( 4 ) ) $ RESULT( 4 ) = DTEMP K = K + 1 -- 2.34.1