Skip to content

Commit 22d1721

Browse files
angschangsch
committed
Add missing numerical tests for TREVC3
At least some tests, though there are still code paths that are not covered * input sizes defined in nep.in are small * RWORK in [CZ]TREVC3 is de factor defined as N-vector from the input file and limits the blocked computation
1 parent 4f97df9 commit 22d1721

File tree

4 files changed

+297
-24
lines changed

4 files changed

+297
-24
lines changed

‎TESTING/EIG/cchkhs.f

Lines changed: 75 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,7 @@
2121
* .. Array Arguments ..
2222
* LOGICAL DOTYPE( * ), SELECT( * )
2323
* INTEGER ISEED( 4 ), IWORK( * ), NN( * )
24-
* REAL RESULT( 14 ), RWORK( * )
24+
* REAL RESULT( 16 ), RWORK( * )
2525
* COMPLEX A( LDA, * ), EVECTL( LDU, * ),
2626
* $ EVECTR( LDU, * ), EVECTX( LDU, * ),
2727
* $ EVECTY( LDU, * ), H( LDA, * ), T1( LDA, * ),
@@ -64,10 +64,15 @@
6464
*> eigenvectors of H. Y is lower triangular, and X is
6565
*> upper triangular.
6666
*>
67+
*> CTREVC3 computes left and right eigenvector matrices
68+
*> from a Schur matrix T and backtransforms them with Z
69+
*> to eigenvector matrices L and R for A. L and R are
70+
*> GE matrices.
71+
*>
6772
*> When CCHKHS is called, a number of matrix "sizes" ("n's") and a
6873
*> number of matrix "types" are specified. For each size ("n")
6974
*> and each type of matrix, one matrix will be generated and used
70-
*> to test the nonsymmetric eigenroutines. For each matrix, 14
75+
*> to test the nonsymmetric eigenroutines. For each matrix, 16
7176
*> tests will be performed:
7277
*>
7378
*> (1) | A - U H U**H | / ( |A| n ulp )
@@ -98,6 +103,10 @@
98103
*>
99104
*> (14) | Y**H A - W**H Y | / ( |A| |Y| ulp )
100105
*>
106+
*> (15) | AR - RW | / ( |A| |R| ulp )
107+
*>
108+
*> (16) | LA - WL | / ( |A| |L| ulp )
109+
*>
101110
*> The "sizes" are specified by an array NN(1:NSIZES); the value of
102111
*> each element NN(j) specifies one size.
103112
*> The "types" are specified by a logical array DOTYPE( 1:NTYPES );
@@ -331,7 +340,7 @@
331340
*> Workspace. Could be equivalenced to IWORK, but not RWORK.
332341
*> Modified.
333342
*>
334-
*> RESULT - REAL array, dimension (14)
343+
*> RESULT - REAL array, dimension (16)
335344
*> The values computed by the fourteen tests described above.
336345
*> The values are currently limited to 1/ulp, to avoid
337346
*> overflow.
@@ -421,7 +430,7 @@ SUBROUTINE CCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
421430
* .. Array Arguments ..
422431
LOGICAL DOTYPE( * ), SELECT( * )
423432
INTEGER ISEED( 4 ), IWORK( * ), NN( * )
424-
REAL RESULT( 14 ), RWORK( * )
433+
REAL RESULT( 16 ), RWORK( * )
425434
COMPLEX A( LDA, * ), EVECTL( LDU, * ),
426435
$ EVECTR( LDU, * ), EVECTX( LDU, * ),
427436
$ EVECTY( LDU, * ), H( LDA, * ), T1( LDA, * ),
@@ -463,8 +472,8 @@ SUBROUTINE CCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
463472
* .. External Subroutines ..
464473
EXTERNAL CCOPY, CGEHRD, CGEMM, CGET10, CGET22, CHSEIN,
465474
$ CHSEQR, CHST01, CLACPY, CLASET, CLATME, CLATMR,
466-
$ CLATMS, CTREVC, CUNGHR, CUNMHR, SLABAD, SLAFTS,
467-
$ SLASUM, XERBLA
475+
$ CLATMS, CTREVC, CTREVC3, CUNGHR, CUNMHR,
476+
$ SLABAD, SLAFTS, SLASUM, XERBLA
468477
* ..
469478
* .. Intrinsic Functions ..
470479
INTRINSIC ABS, MAX, MIN, REAL, SQRT
@@ -1067,6 +1076,66 @@ SUBROUTINE CCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
10671076
$ RESULT( 14 ) = DUMMA( 3 )*ANINV
10681077
END IF
10691078
*
1079+
* Compute Left and Right Eigenvectors of A
1080+
*
1081+
* Compute a Right eigenvector matrix:
1082+
*
1083+
NTEST = 15
1084+
RESULT( 15 ) = ULPINV
1085+
*
1086+
CALL CLACPY( ' ', N, N, UZ, LDU, EVECTR, LDU )
1087+
*
1088+
CALL CTREVC3( 'Right', 'Back', SELECT, N, T1, LDA, CDUMMA,
1089+
$ LDU, EVECTR, LDU, N, IN, WORK, NWORK, RWORK,
1090+
$ N, IINFO )
1091+
IF( IINFO.NE.0 ) THEN
1092+
WRITE( NOUNIT, FMT = 9999 )'CTREVC3(R,B)', IINFO, N,
1093+
$ JTYPE, IOLDSD
1094+
INFO = ABS( IINFO )
1095+
GO TO 250
1096+
END IF
1097+
*
1098+
* Test 15: | AR - RW | / ( |A| |R| ulp )
1099+
*
1100+
* (from Schur decomposition)
1101+
*
1102+
CALL CGET22( 'N', 'N', 'N', N, A, LDA, EVECTR, LDU, W1,
1103+
$ WORK, RWORK, DUMMA( 1 ) )
1104+
RESULT( 15 ) = DUMMA( 1 )
1105+
IF( DUMMA( 2 ).GT.THRESH ) THEN
1106+
WRITE( NOUNIT, FMT = 9998 )'Right', 'CTREVC3',
1107+
$ DUMMA( 2 ), N, JTYPE, IOLDSD
1108+
END IF
1109+
*
1110+
* Compute a Left eigenvector matrix:
1111+
*
1112+
NTEST = 16
1113+
RESULT( 16 ) = ULPINV
1114+
*
1115+
CALL CLACPY( ' ', N, N, UZ, LDU, EVECTL, LDU )
1116+
*
1117+
CALL CTREVC3( 'Left', 'Back', SELECT, N, T1, LDA, EVECTL,
1118+
$ LDU, CDUMMA, LDU, N, IN, WORK, NWORK, RWORK,
1119+
$ N, IINFO )
1120+
IF( IINFO.NE.0 ) THEN
1121+
WRITE( NOUNIT, FMT = 9999 )'CTREVC3(L,B)', IINFO, N,
1122+
$ JTYPE, IOLDSD
1123+
INFO = ABS( IINFO )
1124+
GO TO 250
1125+
END IF
1126+
*
1127+
* Test 16: | LA - WL | / ( |A| |L| ulp )
1128+
*
1129+
* (from Schur decomposition)
1130+
*
1131+
CALL CGET22( 'Conj', 'N', 'Conj', N, A, LDA, EVECTL, LDU,
1132+
$ W1, WORK, RWORK, DUMMA( 3 ) )
1133+
RESULT( 16 ) = DUMMA( 3 )
1134+
IF( DUMMA( 4 ).GT.THRESH ) THEN
1135+
WRITE( NOUNIT, FMT = 9998 )'Left', 'CTREVC3', DUMMA( 4 ),
1136+
$ N, JTYPE, IOLDSD
1137+
END IF
1138+
*
10701139
* End of Loop -- Check for RESULT(j) > THRESH
10711140
*
10721141
240 CONTINUE

‎TESTING/EIG/dchkhs.f

Lines changed: 75 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@
2323
* INTEGER ISEED( 4 ), IWORK( * ), NN( * )
2424
* DOUBLE PRECISION A( LDA, * ), EVECTL( LDU, * ),
2525
* $ EVECTR( LDU, * ), EVECTX( LDU, * ),
26-
* $ EVECTY( LDU, * ), H( LDA, * ), RESULT( 14 ),
26+
* $ EVECTY( LDU, * ), H( LDA, * ), RESULT( 16 ),
2727
* $ T1( LDA, * ), T2( LDA, * ), TAU( * ),
2828
* $ U( LDU, * ), UU( LDU, * ), UZ( LDU, * ),
2929
* $ WI1( * ), WI2( * ), WI3( * ), WORK( * ),
@@ -49,15 +49,21 @@
4949
*> T is "quasi-triangular", and the eigenvalue vector W.
5050
*>
5151
*> DTREVC computes the left and right eigenvector matrices
52-
*> L and R for T.
52+
*> L and R for T. L is lower quasi-triangular, and R is
53+
*> upper quasi-triangular.
5354
*>
5455
*> DHSEIN computes the left and right eigenvector matrices
5556
*> Y and X for H, using inverse iteration.
5657
*>
58+
*> DTREVC3 computes left and right eigenvector matrices
59+
*> from a Schur matrix T and backtransforms them with Z
60+
*> to eigenvector matrices L and R for A. L and R are
61+
*> GE matrices.
62+
*>
5763
*> When DCHKHS is called, a number of matrix "sizes" ("n's") and a
5864
*> number of matrix "types" are specified. For each size ("n")
5965
*> and each type of matrix, one matrix will be generated and used
60-
*> to test the nonsymmetric eigenroutines. For each matrix, 14
66+
*> to test the nonsymmetric eigenroutines. For each matrix, 16
6167
*> tests will be performed:
6268
*>
6369
*> (1) | A - U H U**T | / ( |A| n ulp )
@@ -88,6 +94,10 @@
8894
*>
8995
*> (14) | Y**H A - W**H Y | / ( |A| |Y| ulp )
9096
*>
97+
*> (15) | AR - RW | / ( |A| |R| ulp )
98+
*>
99+
*> (16) | LA - WL | / ( |A| |L| ulp )
100+
*>
91101
*> The "sizes" are specified by an array NN(1:NSIZES); the value of
92102
*> each element NN(j) specifies one size.
93103
*> The "types" are specified by a logical array DOTYPE( 1:NTYPES );
@@ -331,7 +341,7 @@
331341
*> Workspace.
332342
*> Modified.
333343
*>
334-
*> RESULT - DOUBLE PRECISION array, dimension (14)
344+
*> RESULT - DOUBLE PRECISION array, dimension (16)
335345
*> The values computed by the fourteen tests described above.
336346
*> The values are currently limited to 1/ulp, to avoid
337347
*> overflow.
@@ -423,7 +433,7 @@ SUBROUTINE DCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
423433
INTEGER ISEED( 4 ), IWORK( * ), NN( * )
424434
DOUBLE PRECISION A( LDA, * ), EVECTL( LDU, * ),
425435
$ EVECTR( LDU, * ), EVECTX( LDU, * ),
426-
$ EVECTY( LDU, * ), H( LDA, * ), RESULT( 14 ),
436+
$ EVECTY( LDU, * ), H( LDA, * ), RESULT( 16 ),
427437
$ T1( LDA, * ), T2( LDA, * ), TAU( * ),
428438
$ U( LDU, * ), UU( LDU, * ), UZ( LDU, * ),
429439
$ WI1( * ), WI2( * ), WI3( * ), WORK( * ),
@@ -461,7 +471,7 @@ SUBROUTINE DCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
461471
EXTERNAL DCOPY, DGEHRD, DGEMM, DGET10, DGET22, DHSEIN,
462472
$ DHSEQR, DHST01, DLABAD, DLACPY, DLAFTS, DLASET,
463473
$ DLASUM, DLATME, DLATMR, DLATMS, DORGHR, DORMHR,
464-
$ DTREVC, XERBLA
474+
$ DTREVC, DTREVC3, XERBLA
465475
* ..
466476
* .. Intrinsic Functions ..
467477
INTRINSIC ABS, DBLE, MAX, MIN, SQRT
@@ -561,7 +571,7 @@ SUBROUTINE DCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
561571
*
562572
* Initialize RESULT
563573
*
564-
DO 30 J = 1, 14
574+
DO 30 J = 1, 16
565575
RESULT( J ) = ZERO
566576
30 CONTINUE
567577
*
@@ -1108,6 +1118,64 @@ SUBROUTINE DCHKHS( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
11081118
$ RESULT( 14 ) = DUMMA( 3 )*ANINV
11091119
END IF
11101120
*
1121+
* Compute Left and Right Eigenvectors of A
1122+
*
1123+
* Compute a Right eigenvector matrix:
1124+
*
1125+
NTEST = 15
1126+
RESULT( 15 ) = ULPINV
1127+
*
1128+
CALL DLACPY( ' ', N, N, UZ, LDU, EVECTR, LDU )
1129+
*
1130+
CALL DTREVC3( 'Right', 'Back', SELECT, N, T1, LDA, DUMMA,
1131+
$ LDU, EVECTR, LDU, N, IN, WORK, NWORK, IINFO )
1132+
IF( IINFO.NE.0 ) THEN
1133+
WRITE( NOUNIT, FMT = 9999 )'DTREVC3(R,B)', IINFO, N,
1134+
$ JTYPE, IOLDSD
1135+
INFO = ABS( IINFO )
1136+
GO TO 250
1137+
END IF
1138+
*
1139+
* Test 15: | AR - RW | / ( |A| |R| ulp )
1140+
*
1141+
* (from Schur decomposition)
1142+
*
1143+
CALL DGET22( 'N', 'N', 'N', N, A, LDA, EVECTR, LDU, WR1,
1144+
$ WI1, WORK, DUMMA( 1 ) )
1145+
RESULT( 15 ) = DUMMA( 1 )
1146+
IF( DUMMA( 2 ).GT.THRESH ) THEN
1147+
WRITE( NOUNIT, FMT = 9998 )'Right', 'DTREVC3',
1148+
$ DUMMA( 2 ), N, JTYPE, IOLDSD
1149+
END IF
1150+
*
1151+
* Compute a Left eigenvector matrix:
1152+
*
1153+
NTEST = 16
1154+
RESULT( 16 ) = ULPINV
1155+
*
1156+
CALL DLACPY( ' ', N, N, UZ, LDU, EVECTL, LDU )
1157+
*
1158+
CALL DTREVC3( 'Left', 'Back', SELECT, N, T1, LDA, EVECTL,
1159+
$ LDU, DUMMA, LDU, N, IN, WORK, NWORK, IINFO )
1160+
IF( IINFO.NE.0 ) THEN
1161+
WRITE( NOUNIT, FMT = 9999 )'DTREVC3(L,B)', IINFO, N,
1162+
$ JTYPE, IOLDSD
1163+
INFO = ABS( IINFO )
1164+
GO TO 250
1165+
END IF
1166+
*
1167+
* Test 16: | LA - WL | / ( |A| |L| ulp )
1168+
*
1169+
* (from Schur decomposition)
1170+
*
1171+
CALL DGET22( 'Trans', 'N', 'Conj', N, A, LDA, EVECTL, LDU,
1172+
$ WR1, WI1, WORK, DUMMA( 3 ) )
1173+
RESULT( 16 ) = DUMMA( 3 )
1174+
IF( DUMMA( 4 ).GT.THRESH ) THEN
1175+
WRITE( NOUNIT, FMT = 9998 )'Left', 'DTREVC3', DUMMA( 4 ),
1176+
$ N, JTYPE, IOLDSD
1177+
END IF
1178+
*
11111179
* End of Loop -- Check for RESULT(j) > THRESH
11121180
*
11131181
250 CONTINUE

0 commit comments

Comments
 (0)