summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--TESTING/LIN/cchkhe_rook.f64
-rw-r--r--TESTING/LIN/cchksy_rook.f54
-rw-r--r--TESTING/LIN/dchksy_rook.f58
-rw-r--r--TESTING/LIN/schksy_rook.f59
-rw-r--r--TESTING/LIN/zchkhe_rook.f64
-rw-r--r--TESTING/LIN/zchksy_rook.f54
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-20 11:05:08 +0000