From d1ac8d7790e090076aa132bf3f15368e2407a831 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Thu, 10 Sep 2026 09:14:41 +0100 Subject: [PATCH] TESTING: scale the xGEEV eigenvalue-consistency check by n ulp |W| xGEEV does not promise identical eigenvalues whether or not eigenvectors are asked for: the two paths cover different index ranges, so rounding that depends on the trip count makes them differ. Test 5 now measures the difference against n |W| ulp, as tests 1 and 2 of the same driver already do, instead of requiring bit equality. Closes #732 item 3. --- TESTING/EIG/cdrvev.f | 32 +++++++++++++++++++++++--------- TESTING/EIG/cdrvvx.f | 3 +-- TESTING/EIG/cget23.f | 29 ++++++++++++++++++++++------- TESTING/EIG/ddrvev.f | 38 +++++++++++++++++++++++++++++--------- TESTING/EIG/ddrvvx.f | 3 +-- TESTING/EIG/dget23.f | 35 ++++++++++++++++++++++++++++------- TESTING/EIG/sdrvev.f | 38 +++++++++++++++++++++++++++++--------- TESTING/EIG/sdrvvx.f | 3 +-- TESTING/EIG/sget23.f | 35 ++++++++++++++++++++++++++++------- TESTING/EIG/zdrvev.f | 32 +++++++++++++++++++++++--------- TESTING/EIG/zdrvvx.f | 3 +-- TESTING/EIG/zget23.f | 29 ++++++++++++++++++++++------- 12 files changed, 208 insertions(+), 72 deletions(-) diff --git a/TESTING/EIG/cdrvev.f b/TESTING/EIG/cdrvev.f index 3e6b98ff7..d911225a8 100644 --- a/TESTING/EIG/cdrvev.f +++ b/TESTING/EIG/cdrvev.f @@ -429,7 +429,7 @@ SUBROUTINE CDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, $ JTYPE, MTYPES, N, NERRS, NFAIL, NMAX, $ NNWORK, NTEST, NTESTF, NTESTT REAL ANORM, COND, CONDS, OVFL, RTULP, RTULPI, TNRM, - $ ULP, ULPINV, UNFL, VMX, VRMX, VTST + $ ULP, ULPINV, UNFL, VMX, VRMX, VTST, WDIF, WNRM * .. * .. Local Arrays .. INTEGER IDUMMA( 1 ), IOLDSD( 4 ), KCONDS( MAXTYP ), @@ -799,10 +799,15 @@ SUBROUTINE CDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * * Do Test (5) * + WNRM = ZERO + WDIF = ZERO DO 150 J = 1, N - IF( W( J ).NE.W1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( W( J ) ), ABS( W1( J ) ) ) + WDIF = MAX( WDIF, ABS( W( J )-W1( J ) ) ) 150 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( UNFL, ULP*REAL( N )* + $ MAX( WNRM, WDIF ) ) ) * * Compute eigenvalues and right eigenvectors, and test them * @@ -819,10 +824,15 @@ SUBROUTINE CDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * * Do Test (5) again * + WNRM = ZERO + WDIF = ZERO DO 160 J = 1, N - IF( W( J ).NE.W1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( W( J ) ), ABS( W1( J ) ) ) + WDIF = MAX( WDIF, ABS( W( J )-W1( J ) ) ) 160 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( UNFL, ULP*REAL( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (6) * @@ -848,10 +858,15 @@ SUBROUTINE CDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * * Do Test (5) again * + WNRM = ZERO + WDIF = ZERO DO 190 J = 1, N - IF( W( J ).NE.W1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( W( J ) ), ABS( W1( J ) ) ) + WDIF = MAX( WDIF, ABS( W( J )-W1( J ) ) ) 190 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( UNFL, ULP*REAL( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (7) * @@ -932,8 +947,7 @@ SUBROUTINE CDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, $ / ' 2 = | conj-trans(A) VL - VL conj-trans(W) | /', $ ' ( n |A| ulp ) ', / ' 3 = | |VR(i)| - 1 | / ulp ', $ / ' 4 = | |VL(i)| - 1 | / ulp ', - $ / ' 5 = 0 if W same no matter if VR or VL computed,', - $ ' 1/ulp otherwise', / + $ / ' 5 = | W - W(other JOBVL/JOBVR) | / ( n |W| ulp ) ', / $ ' 6 = 0 if VR same no matter if VL computed,', $ ' 1/ulp otherwise', / $ ' 7 = 0 if VL same no matter if VR computed,', diff --git a/TESTING/EIG/cdrvvx.f b/TESTING/EIG/cdrvvx.f index 99931b6ef..ab05be584 100644 --- a/TESTING/EIG/cdrvvx.f +++ b/TESTING/EIG/cdrvvx.f @@ -969,8 +969,7 @@ SUBROUTINE CDRVVX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, $ / ' 2 = | transpose(A) VL - VL W | / ( n |A| ulp ) ', $ / ' 3 = | |VR(i)| - 1 | / ulp ', $ / ' 4 = | |VL(i)| - 1 | / ulp ', - $ / ' 5 = 0 if W same no matter if VR or VL computed,', - $ ' 1/ulp otherwise', / + $ / ' 5 = | W - W(other JOBVL/JOBVR) | / ( n |W| ulp ) ', / $ ' 6 = 0 if VR same no matter what else computed,', $ ' 1/ulp otherwise', / $ ' 7 = 0 if VL same no matter what else computed,', diff --git a/TESTING/EIG/cget23.f b/TESTING/EIG/cget23.f index e2c67785d..6226a681d 100644 --- a/TESTING/EIG/cget23.f +++ b/TESTING/EIG/cget23.f @@ -404,7 +404,7 @@ SUBROUTINE CGET23( COMP, ISRT, BALANC, JTYPE, THRESH, ISEED, $ J, JJ, KMIN REAL ABNRM, ABNRM1, EPS, SMLNUM, TNRM, TOL, TOLIN, $ ULP, ULPINV, V, VMAX, VMX, VRICMP, VRIMIN, - $ VRMX, VTST + $ VRMX, VTST, WDIF, WNRM COMPLEX CTMP * .. * .. Local Arrays .. @@ -580,10 +580,15 @@ SUBROUTINE CGET23( COMP, ISRT, BALANC, JTYPE, THRESH, ISEED, * * Do Test (5) * + WNRM = ZERO + WDIF = ZERO DO 60 J = 1, N - IF( W( J ).NE.W1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( W( J ) ), ABS( W1( J ) ) ) + WDIF = MAX( WDIF, ABS( W( J )-W1( J ) ) ) 60 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( SMLNUM, ULP*REAL( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (8) * @@ -630,10 +635,15 @@ SUBROUTINE CGET23( COMP, ISRT, BALANC, JTYPE, THRESH, ISEED, * * Do Test (5) again * + WNRM = ZERO + WDIF = ZERO DO 90 J = 1, N - IF( W( J ).NE.W1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( W( J ) ), ABS( W1( J ) ) ) + WDIF = MAX( WDIF, ABS( W( J )-W1( J ) ) ) 90 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( SMLNUM, ULP*REAL( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (6) * @@ -689,10 +699,15 @@ SUBROUTINE CGET23( COMP, ISRT, BALANC, JTYPE, THRESH, ISEED, * * Do Test (5) again * + WNRM = ZERO + WDIF = ZERO DO 140 J = 1, N - IF( W( J ).NE.W1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( W( J ) ), ABS( W1( J ) ) ) + WDIF = MAX( WDIF, ABS( W( J )-W1( J ) ) ) 140 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( SMLNUM, ULP*REAL( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (7) * diff --git a/TESTING/EIG/ddrvev.f b/TESTING/EIG/ddrvev.f index bc0104043..8a4b33705 100644 --- a/TESTING/EIG/ddrvev.f +++ b/TESTING/EIG/ddrvev.f @@ -439,7 +439,7 @@ SUBROUTINE DDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, $ JTYPE, MTYPES, N, NERRS, NFAIL, NMAX, NNWORK, $ NTEST, NTESTF, NTESTT DOUBLE PRECISION ANORM, COND, CONDS, OVFL, RTULP, RTULPI, TNRM, - $ ULP, ULPINV, UNFL, VMX, VRMX, VTST + $ ULP, ULPINV, UNFL, VMX, VRMX, VTST, WDIF, WNRM * .. * .. Local Arrays .. CHARACTER ADUMMA( 1 ) @@ -827,10 +827,17 @@ SUBROUTINE DDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * * Do Test (5) * + WNRM = ZERO + WDIF = ZERO DO 150 J = 1, N - IF( WR( J ).NE.WR1( J ) .OR. WI( J ).NE.WI1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( WR( J ) )+ABS( WI( J ) ), + $ ABS( WR1( J ) )+ABS( WI1( J ) ) ) + WDIF = MAX( WDIF, ABS( WR( J )-WR1( J ) )+ + $ ABS( WI( J )-WI1( J ) ) ) 150 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( UNFL, ULP*DBLE( N )* + $ MAX( WNRM, WDIF ) ) ) * * Compute eigenvalues and right eigenvectors, and test them * @@ -847,10 +854,17 @@ SUBROUTINE DDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * * Do Test (5) again * + WNRM = ZERO + WDIF = ZERO DO 160 J = 1, N - IF( WR( J ).NE.WR1( J ) .OR. WI( J ).NE.WI1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( WR( J ) )+ABS( WI( J ) ), + $ ABS( WR1( J ) )+ABS( WI1( J ) ) ) + WDIF = MAX( WDIF, ABS( WR( J )-WR1( J ) )+ + $ ABS( WI( J )-WI1( J ) ) ) 160 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( UNFL, ULP*DBLE( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (6) * @@ -876,10 +890,17 @@ SUBROUTINE DDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * * Do Test (5) again * + WNRM = ZERO + WDIF = ZERO DO 190 J = 1, N - IF( WR( J ).NE.WR1( J ) .OR. WI( J ).NE.WI1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( WR( J ) )+ABS( WI( J ) ), + $ ABS( WR1( J ) )+ABS( WI1( J ) ) ) + WDIF = MAX( WDIF, ABS( WR( J )-WR1( J ) )+ + $ ABS( WI( J )-WI1( J ) ) ) 190 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( UNFL, ULP*DBLE( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (7) * @@ -959,8 +980,7 @@ SUBROUTINE DDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, $ / ' 2 = | transpose(A) VL - VL W | / ( n |A| ulp ) ', $ / ' 3 = | |VR(i)| - 1 | / ulp ', $ / ' 4 = | |VL(i)| - 1 | / ulp ', - $ / ' 5 = 0 if W same no matter if VR or VL computed,', - $ ' 1/ulp otherwise', / + $ / ' 5 = | W - W(other JOBVL/JOBVR) | / ( n |W| ulp ) ', / $ ' 6 = 0 if VR same no matter if VL computed,', $ ' 1/ulp otherwise', / $ ' 7 = 0 if VL same no matter if VR computed,', diff --git a/TESTING/EIG/ddrvvx.f b/TESTING/EIG/ddrvvx.f index ae0c438b6..06cec85f2 100644 --- a/TESTING/EIG/ddrvvx.f +++ b/TESTING/EIG/ddrvvx.f @@ -991,8 +991,7 @@ SUBROUTINE DDRVVX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, $ / ' 2 = | transpose(A) VL - VL W | / ( n |A| ulp ) ', $ / ' 3 = | |VR(i)| - 1 | / ulp ', $ / ' 4 = | |VL(i)| - 1 | / ulp ', - $ / ' 5 = 0 if W same no matter if VR or VL computed,', - $ ' 1/ulp otherwise', / + $ / ' 5 = | W - W(other JOBVL/JOBVR) | / ( n |W| ulp ) ', / $ ' 6 = 0 if VR same no matter what else computed,', $ ' 1/ulp otherwise', / $ ' 7 = 0 if VL same no matter what else computed,', diff --git a/TESTING/EIG/dget23.f b/TESTING/EIG/dget23.f index 6588dfadd..a61435cbb 100644 --- a/TESTING/EIG/dget23.f +++ b/TESTING/EIG/dget23.f @@ -414,7 +414,7 @@ SUBROUTINE DGET23( COMP, BALANC, JTYPE, THRESH, ISEED, NOUNIT, N, $ J, JJ, KMIN DOUBLE PRECISION ABNRM, ABNRM1, EPS, SMLNUM, TNRM, TOL, TOLIN, $ ULP, ULPINV, V, VIMIN, VMAX, VMX, VRMIN, VRMX, - $ VTST + $ VTST, WDIF, WNRM * .. * .. Local Arrays .. CHARACTER SENS( 2 ) @@ -600,10 +600,17 @@ SUBROUTINE DGET23( COMP, BALANC, JTYPE, THRESH, ISEED, NOUNIT, N, * * Do Test (5) * + WNRM = ZERO + WDIF = ZERO DO 60 J = 1, N - IF( WR( J ).NE.WR1( J ) .OR. WI( J ).NE.WI1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( WR( J ) )+ABS( WI( J ) ), + $ ABS( WR1( J ) )+ABS( WI1( J ) ) ) + WDIF = MAX( WDIF, ABS( WR( J )-WR1( J ) )+ + $ ABS( WI( J )-WI1( J ) ) ) 60 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( SMLNUM, ULP*DBLE( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (8) * @@ -650,10 +657,17 @@ SUBROUTINE DGET23( COMP, BALANC, JTYPE, THRESH, ISEED, NOUNIT, N, * * Do Test (5) again * + WNRM = ZERO + WDIF = ZERO DO 90 J = 1, N - IF( WR( J ).NE.WR1( J ) .OR. WI( J ).NE.WI1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( WR( J ) )+ABS( WI( J ) ), + $ ABS( WR1( J ) )+ABS( WI1( J ) ) ) + WDIF = MAX( WDIF, ABS( WR( J )-WR1( J ) )+ + $ ABS( WI( J )-WI1( J ) ) ) 90 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( SMLNUM, ULP*DBLE( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (6) * @@ -709,10 +723,17 @@ SUBROUTINE DGET23( COMP, BALANC, JTYPE, THRESH, ISEED, NOUNIT, N, * * Do Test (5) again * + WNRM = ZERO + WDIF = ZERO DO 140 J = 1, N - IF( WR( J ).NE.WR1( J ) .OR. WI( J ).NE.WI1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( WR( J ) )+ABS( WI( J ) ), + $ ABS( WR1( J ) )+ABS( WI1( J ) ) ) + WDIF = MAX( WDIF, ABS( WR( J )-WR1( J ) )+ + $ ABS( WI( J )-WI1( J ) ) ) 140 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( SMLNUM, ULP*DBLE( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (7) * diff --git a/TESTING/EIG/sdrvev.f b/TESTING/EIG/sdrvev.f index d7131338a..3f84f1324 100644 --- a/TESTING/EIG/sdrvev.f +++ b/TESTING/EIG/sdrvev.f @@ -439,7 +439,7 @@ SUBROUTINE SDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, $ JTYPE, MTYPES, N, NERRS, NFAIL, NMAX, $ NNWORK, NTEST, NTESTF, NTESTT REAL ANORM, COND, CONDS, OVFL, RTULP, RTULPI, TNRM, - $ ULP, ULPINV, UNFL, VMX, VRMX, VTST + $ ULP, ULPINV, UNFL, VMX, VRMX, VTST, WDIF, WNRM * .. * .. Local Arrays .. CHARACTER ADUMMA( 1 ) @@ -827,10 +827,17 @@ SUBROUTINE SDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * * Do Test (5) * + WNRM = ZERO + WDIF = ZERO DO 150 J = 1, N - IF( WR( J ).NE.WR1( J ) .OR. WI( J ).NE.WI1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( WR( J ) )+ABS( WI( J ) ), + $ ABS( WR1( J ) )+ABS( WI1( J ) ) ) + WDIF = MAX( WDIF, ABS( WR( J )-WR1( J ) )+ + $ ABS( WI( J )-WI1( J ) ) ) 150 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( UNFL, ULP*REAL( N )* + $ MAX( WNRM, WDIF ) ) ) * * Compute eigenvalues and right eigenvectors, and test them * @@ -847,10 +854,17 @@ SUBROUTINE SDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * * Do Test (5) again * + WNRM = ZERO + WDIF = ZERO DO 160 J = 1, N - IF( WR( J ).NE.WR1( J ) .OR. WI( J ).NE.WI1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( WR( J ) )+ABS( WI( J ) ), + $ ABS( WR1( J ) )+ABS( WI1( J ) ) ) + WDIF = MAX( WDIF, ABS( WR( J )-WR1( J ) )+ + $ ABS( WI( J )-WI1( J ) ) ) 160 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( UNFL, ULP*REAL( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (6) * @@ -876,10 +890,17 @@ SUBROUTINE SDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * * Do Test (5) again * + WNRM = ZERO + WDIF = ZERO DO 190 J = 1, N - IF( WR( J ).NE.WR1( J ) .OR. WI( J ).NE.WI1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( WR( J ) )+ABS( WI( J ) ), + $ ABS( WR1( J ) )+ABS( WI1( J ) ) ) + WDIF = MAX( WDIF, ABS( WR( J )-WR1( J ) )+ + $ ABS( WI( J )-WI1( J ) ) ) 190 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( UNFL, ULP*REAL( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (7) * @@ -959,8 +980,7 @@ SUBROUTINE SDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, $ / ' 2 = | transpose(A) VL - VL W | / ( n |A| ulp ) ', $ / ' 3 = | |VR(i)| - 1 | / ulp ', $ / ' 4 = | |VL(i)| - 1 | / ulp ', - $ / ' 5 = 0 if W same no matter if VR or VL computed,', - $ ' 1/ulp otherwise', / + $ / ' 5 = | W - W(other JOBVL/JOBVR) | / ( n |W| ulp ) ', / $ ' 6 = 0 if VR same no matter if VL computed,', $ ' 1/ulp otherwise', / $ ' 7 = 0 if VL same no matter if VR computed,', diff --git a/TESTING/EIG/sdrvvx.f b/TESTING/EIG/sdrvvx.f index 0d7b8d380..1cb2b3a85 100644 --- a/TESTING/EIG/sdrvvx.f +++ b/TESTING/EIG/sdrvvx.f @@ -990,8 +990,7 @@ SUBROUTINE SDRVVX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, $ / ' 2 = | transpose(A) VL - VL W | / ( n |A| ulp ) ', $ / ' 3 = | |VR(i)| - 1 | / ulp ', $ / ' 4 = | |VL(i)| - 1 | / ulp ', - $ / ' 5 = 0 if W same no matter if VR or VL computed,', - $ ' 1/ulp otherwise', / + $ / ' 5 = | W - W(other JOBVL/JOBVR) | / ( n |W| ulp ) ', / $ ' 6 = 0 if VR same no matter what else computed,', $ ' 1/ulp otherwise', / $ ' 7 = 0 if VL same no matter what else computed,', diff --git a/TESTING/EIG/sget23.f b/TESTING/EIG/sget23.f index 8c3c26f09..cd57bd61b 100644 --- a/TESTING/EIG/sget23.f +++ b/TESTING/EIG/sget23.f @@ -414,7 +414,7 @@ SUBROUTINE SGET23( COMP, BALANC, JTYPE, THRESH, ISEED, NOUNIT, N, $ J, JJ, KMIN REAL ABNRM, ABNRM1, EPS, SMLNUM, TNRM, TOL, TOLIN, $ ULP, ULPINV, V, VIMIN, VMAX, VMX, VRMIN, VRMX, - $ VTST + $ VTST, WDIF, WNRM * .. * .. Local Arrays .. CHARACTER SENS( 2 ) @@ -600,10 +600,17 @@ SUBROUTINE SGET23( COMP, BALANC, JTYPE, THRESH, ISEED, NOUNIT, N, * * Do Test (5) * + WNRM = ZERO + WDIF = ZERO DO 60 J = 1, N - IF( WR( J ).NE.WR1( J ) .OR. WI( J ).NE.WI1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( WR( J ) )+ABS( WI( J ) ), + $ ABS( WR1( J ) )+ABS( WI1( J ) ) ) + WDIF = MAX( WDIF, ABS( WR( J )-WR1( J ) )+ + $ ABS( WI( J )-WI1( J ) ) ) 60 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( SMLNUM, ULP*REAL( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (8) * @@ -650,10 +657,17 @@ SUBROUTINE SGET23( COMP, BALANC, JTYPE, THRESH, ISEED, NOUNIT, N, * * Do Test (5) again * + WNRM = ZERO + WDIF = ZERO DO 90 J = 1, N - IF( WR( J ).NE.WR1( J ) .OR. WI( J ).NE.WI1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( WR( J ) )+ABS( WI( J ) ), + $ ABS( WR1( J ) )+ABS( WI1( J ) ) ) + WDIF = MAX( WDIF, ABS( WR( J )-WR1( J ) )+ + $ ABS( WI( J )-WI1( J ) ) ) 90 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( SMLNUM, ULP*REAL( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (6) * @@ -709,10 +723,17 @@ SUBROUTINE SGET23( COMP, BALANC, JTYPE, THRESH, ISEED, NOUNIT, N, * * Do Test (5) again * + WNRM = ZERO + WDIF = ZERO DO 140 J = 1, N - IF( WR( J ).NE.WR1( J ) .OR. WI( J ).NE.WI1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( WR( J ) )+ABS( WI( J ) ), + $ ABS( WR1( J ) )+ABS( WI1( J ) ) ) + WDIF = MAX( WDIF, ABS( WR( J )-WR1( J ) )+ + $ ABS( WI( J )-WI1( J ) ) ) 140 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( SMLNUM, ULP*REAL( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (7) * diff --git a/TESTING/EIG/zdrvev.f b/TESTING/EIG/zdrvev.f index c6fec57ab..bd8a2d573 100644 --- a/TESTING/EIG/zdrvev.f +++ b/TESTING/EIG/zdrvev.f @@ -429,7 +429,7 @@ SUBROUTINE ZDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, $ JTYPE, MTYPES, N, NERRS, NFAIL, NMAX, NNWORK, $ NTEST, NTESTF, NTESTT DOUBLE PRECISION ANORM, COND, CONDS, OVFL, RTULP, RTULPI, TNRM, - $ ULP, ULPINV, UNFL, VMX, VRMX, VTST + $ ULP, ULPINV, UNFL, VMX, VRMX, VTST, WDIF, WNRM * .. * .. Local Arrays .. INTEGER IDUMMA( 1 ), IOLDSD( 4 ), KCONDS( MAXTYP ), @@ -799,10 +799,15 @@ SUBROUTINE ZDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * * Do Test (5) * + WNRM = ZERO + WDIF = ZERO DO 150 J = 1, N - IF( W( J ).NE.W1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( W( J ) ), ABS( W1( J ) ) ) + WDIF = MAX( WDIF, ABS( W( J )-W1( J ) ) ) 150 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( UNFL, ULP*DBLE( N )* + $ MAX( WNRM, WDIF ) ) ) * * Compute eigenvalues and right eigenvectors, and test them * @@ -819,10 +824,15 @@ SUBROUTINE ZDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * * Do Test (5) again * + WNRM = ZERO + WDIF = ZERO DO 160 J = 1, N - IF( W( J ).NE.W1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( W( J ) ), ABS( W1( J ) ) ) + WDIF = MAX( WDIF, ABS( W( J )-W1( J ) ) ) 160 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( UNFL, ULP*DBLE( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (6) * @@ -848,10 +858,15 @@ SUBROUTINE ZDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, * * Do Test (5) again * + WNRM = ZERO + WDIF = ZERO DO 190 J = 1, N - IF( W( J ).NE.W1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( W( J ) ), ABS( W1( J ) ) ) + WDIF = MAX( WDIF, ABS( W( J )-W1( J ) ) ) 190 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( UNFL, ULP*DBLE( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (7) * @@ -932,8 +947,7 @@ SUBROUTINE ZDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, $ / ' 2 = | conj-trans(A) VL - VL conj-trans(W) | /', $ ' ( n |A| ulp ) ', / ' 3 = | |VR(i)| - 1 | / ulp ', $ / ' 4 = | |VL(i)| - 1 | / ulp ', - $ / ' 5 = 0 if W same no matter if VR or VL computed,', - $ ' 1/ulp otherwise', / + $ / ' 5 = | W - W(other JOBVL/JOBVR) | / ( n |W| ulp ) ', / $ ' 6 = 0 if VR same no matter if VL computed,', $ ' 1/ulp otherwise', / $ ' 7 = 0 if VL same no matter if VR computed,', diff --git a/TESTING/EIG/zdrvvx.f b/TESTING/EIG/zdrvvx.f index 8bd6dbc5b..a96b6851c 100644 --- a/TESTING/EIG/zdrvvx.f +++ b/TESTING/EIG/zdrvvx.f @@ -969,8 +969,7 @@ SUBROUTINE ZDRVVX( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, $ / ' 2 = | transpose(A) VL - VL W | / ( n |A| ulp ) ', $ / ' 3 = | |VR(i)| - 1 | / ulp ', $ / ' 4 = | |VL(i)| - 1 | / ulp ', - $ / ' 5 = 0 if W same no matter if VR or VL computed,', - $ ' 1/ulp otherwise', / + $ / ' 5 = | W - W(other JOBVL/JOBVR) | / ( n |W| ulp ) ', / $ ' 6 = 0 if VR same no matter what else computed,', $ ' 1/ulp otherwise', / $ ' 7 = 0 if VL same no matter what else computed,', diff --git a/TESTING/EIG/zget23.f b/TESTING/EIG/zget23.f index 7c84d0fd4..a437899ab 100644 --- a/TESTING/EIG/zget23.f +++ b/TESTING/EIG/zget23.f @@ -404,7 +404,7 @@ SUBROUTINE ZGET23( COMP, ISRT, BALANC, JTYPE, THRESH, ISEED, $ J, JJ, KMIN DOUBLE PRECISION ABNRM, ABNRM1, EPS, SMLNUM, TNRM, TOL, TOLIN, $ ULP, ULPINV, V, VMAX, VMX, VRICMP, VRIMIN, - $ VRMX, VTST + $ VRMX, VTST, WDIF, WNRM COMPLEX*16 CTMP * .. * .. Local Arrays .. @@ -580,10 +580,15 @@ SUBROUTINE ZGET23( COMP, ISRT, BALANC, JTYPE, THRESH, ISEED, * * Do Test (5) * + WNRM = ZERO + WDIF = ZERO DO 60 J = 1, N - IF( W( J ).NE.W1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( W( J ) ), ABS( W1( J ) ) ) + WDIF = MAX( WDIF, ABS( W( J )-W1( J ) ) ) 60 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( SMLNUM, ULP*DBLE( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (8) * @@ -630,10 +635,15 @@ SUBROUTINE ZGET23( COMP, ISRT, BALANC, JTYPE, THRESH, ISEED, * * Do Test (5) again * + WNRM = ZERO + WDIF = ZERO DO 90 J = 1, N - IF( W( J ).NE.W1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( W( J ) ), ABS( W1( J ) ) ) + WDIF = MAX( WDIF, ABS( W( J )-W1( J ) ) ) 90 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( SMLNUM, ULP*DBLE( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (6) * @@ -689,10 +699,15 @@ SUBROUTINE ZGET23( COMP, ISRT, BALANC, JTYPE, THRESH, ISEED, * * Do Test (5) again * + WNRM = ZERO + WDIF = ZERO DO 140 J = 1, N - IF( W( J ).NE.W1( J ) ) - $ RESULT( 5 ) = ULPINV + WNRM = MAX( WNRM, ABS( W( J ) ), ABS( W1( J ) ) ) + WDIF = MAX( WDIF, ABS( W( J )-W1( J ) ) ) 140 CONTINUE + RESULT( 5 ) = MAX( RESULT( 5 ), WDIF / + $ MAX( SMLNUM, ULP*DBLE( N )* + $ MAX( WNRM, WDIF ) ) ) * * Do Test (7) *