1 SUBROUTINE ZCHKEC( THRESH, TSTERR, NIN, NOUT )
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 LOGICAL TSTERR
9 INTEGER NIN, NOUT
10 DOUBLE PRECISION THRESH
11 * ..
12 *
13 * Purpose
14 * =======
15 *
16 * ZCHKEC tests eigen- condition estimation routines
17 * ZTRSYL, CTREXC, CTRSNA, CTRSEN
18 *
19 * In all cases, the routine runs through a fixed set of numerical
20 * examples, subjects them to various tests, and compares the test
21 * results to a threshold THRESH. In addition, ZTRSNA and CTRSEN are
22 * tested by reading in precomputed examples from a file (on input unit
23 * NIN). Output is written to output unit NOUT.
24 *
25 * Arguments
26 * =========
27 *
28 * THRESH (input) DOUBLE PRECISION
29 * Threshold for residual tests. A computed test ratio passes
30 * the threshold if it is less than THRESH.
31 *
32 * TSTERR (input) LOGICAL
33 * Flag that indicates whether error exits are to be tested.
34 *
35 * NIN (input) INTEGER
36 * The logical unit number for input.
37 *
38 * NOUT (input) INTEGER
39 * The logical unit number for output.
40 *
41 * =====================================================================
42 *
43 * .. Local Scalars ..
44 LOGICAL OK
45 CHARACTER*3 PATH
46 INTEGER KTREXC, KTRSEN, KTRSNA, KTRSYL, LTREXC, LTRSYL,
47 $ NTESTS, NTREXC, NTRSYL
48 DOUBLE PRECISION EPS, RTREXC, RTRSYL, SFMIN
49 * ..
50 * .. Local Arrays ..
51 INTEGER LTRSEN( 3 ), LTRSNA( 3 ), NTRSEN( 3 ),
52 $ NTRSNA( 3 )
53 DOUBLE PRECISION RTRSEN( 3 ), RTRSNA( 3 )
54 * ..
55 * .. External Subroutines ..
56 EXTERNAL ZERREC, ZGET35, ZGET36, ZGET37, ZGET38
57 * ..
58 * .. External Functions ..
59 DOUBLE PRECISION DLAMCH
60 EXTERNAL DLAMCH
61 * ..
62 * .. Executable Statements ..
63 *
64 PATH( 1: 1 ) = 'Zomplex precision'
65 PATH( 2: 3 ) = 'EC'
66 EPS = DLAMCH( 'P' )
67 SFMIN = DLAMCH( 'S' )
68 WRITE( NOUT, FMT = 9994 )
69 WRITE( NOUT, FMT = 9993 )EPS, SFMIN
70 WRITE( NOUT, FMT = 9992 )THRESH
71 *
72 * Test error exits if TSTERR is .TRUE.
73 *
74 IF( TSTERR )
75 $ CALL ZERREC( PATH, NOUT )
76 *
77 OK = .TRUE.
78 CALL ZGET35( RTRSYL, LTRSYL, NTRSYL, KTRSYL, NIN )
79 IF( RTRSYL.GT.THRESH ) THEN
80 OK = .FALSE.
81 WRITE( NOUT, FMT = 9999 )RTRSYL, LTRSYL, NTRSYL, KTRSYL
82 END IF
83 *
84 CALL ZGET36( RTREXC, LTREXC, NTREXC, KTREXC, NIN )
85 IF( RTREXC.GT.THRESH .OR. NTREXC.GT.0 ) THEN
86 OK = .FALSE.
87 WRITE( NOUT, FMT = 9998 )RTREXC, LTREXC, NTREXC, KTREXC
88 END IF
89 *
90 CALL ZGET37( RTRSNA, LTRSNA, NTRSNA, KTRSNA, NIN )
91 IF( RTRSNA( 1 ).GT.THRESH .OR. RTRSNA( 2 ).GT.THRESH .OR.
92 $ NTRSNA( 1 ).NE.0 .OR. NTRSNA( 2 ).NE.0 .OR. NTRSNA( 3 ).NE.0 )
93 $ THEN
94 OK = .FALSE.
95 WRITE( NOUT, FMT = 9997 )RTRSNA, LTRSNA, NTRSNA, KTRSNA
96 END IF
97 *
98 CALL ZGET38( RTRSEN, LTRSEN, NTRSEN, KTRSEN, NIN )
99 IF( RTRSEN( 1 ).GT.THRESH .OR. RTRSEN( 2 ).GT.THRESH .OR.
100 $ NTRSEN( 1 ).NE.0 .OR. NTRSEN( 2 ).NE.0 .OR. NTRSEN( 3 ).NE.0 )
101 $ THEN
102 OK = .FALSE.
103 WRITE( NOUT, FMT = 9996 )RTRSEN, LTRSEN, NTRSEN, KTRSEN
104 END IF
105 *
106 NTESTS = KTRSYL + KTREXC + KTRSNA + KTRSEN
107 IF( OK )
108 $ WRITE( NOUT, FMT = 9995 )PATH, NTESTS
109 *
110 9999 FORMAT( ' Error in ZTRSYL: RMAX =', D12.3, / ' LMAX = ', I8,
111 $ ' NINFO=', I8, ' KNT=', I8 )
112 9998 FORMAT( ' Error in ZTREXC: RMAX =', D12.3, / ' LMAX = ', I8,
113 $ ' NINFO=', I8, ' KNT=', I8 )
114 9997 FORMAT( ' Error in ZTRSNA: RMAX =', 3D12.3, / ' LMAX = ', 3I8,
115 $ ' NINFO=', 3I8, ' KNT=', I8 )
116 9996 FORMAT( ' Error in ZTRSEN: RMAX =', 3D12.3, / ' LMAX = ', 3I8,
117 $ ' NINFO=', 3I8, ' KNT=', I8 )
118 9995 FORMAT( / 1X, 'All tests for ', A3,
119 $ ' routines passed the threshold (', I6, ' tests run)' )
120 9994 FORMAT( ' Tests of the Nonsymmetric eigenproblem condition',
121 $ ' estimation routines', / ' ZTRSYL, CTREXC, CTRSNA, CTRSEN',
122 $ / )
123 9993 FORMAT( ' Relative machine precision (EPS) = ', D16.6,
124 $ / ' Safe minimum (SFMIN) = ', D16.6, / )
125 9992 FORMAT( ' Routines pass computational tests if test ratio is ',
126 $ 'less than', F8.2, / / )
127 RETURN
128 *
129 * End of ZCHKEC
130 *
131 END
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 LOGICAL TSTERR
9 INTEGER NIN, NOUT
10 DOUBLE PRECISION THRESH
11 * ..
12 *
13 * Purpose
14 * =======
15 *
16 * ZCHKEC tests eigen- condition estimation routines
17 * ZTRSYL, CTREXC, CTRSNA, CTRSEN
18 *
19 * In all cases, the routine runs through a fixed set of numerical
20 * examples, subjects them to various tests, and compares the test
21 * results to a threshold THRESH. In addition, ZTRSNA and CTRSEN are
22 * tested by reading in precomputed examples from a file (on input unit
23 * NIN). Output is written to output unit NOUT.
24 *
25 * Arguments
26 * =========
27 *
28 * THRESH (input) DOUBLE PRECISION
29 * Threshold for residual tests. A computed test ratio passes
30 * the threshold if it is less than THRESH.
31 *
32 * TSTERR (input) LOGICAL
33 * Flag that indicates whether error exits are to be tested.
34 *
35 * NIN (input) INTEGER
36 * The logical unit number for input.
37 *
38 * NOUT (input) INTEGER
39 * The logical unit number for output.
40 *
41 * =====================================================================
42 *
43 * .. Local Scalars ..
44 LOGICAL OK
45 CHARACTER*3 PATH
46 INTEGER KTREXC, KTRSEN, KTRSNA, KTRSYL, LTREXC, LTRSYL,
47 $ NTESTS, NTREXC, NTRSYL
48 DOUBLE PRECISION EPS, RTREXC, RTRSYL, SFMIN
49 * ..
50 * .. Local Arrays ..
51 INTEGER LTRSEN( 3 ), LTRSNA( 3 ), NTRSEN( 3 ),
52 $ NTRSNA( 3 )
53 DOUBLE PRECISION RTRSEN( 3 ), RTRSNA( 3 )
54 * ..
55 * .. External Subroutines ..
56 EXTERNAL ZERREC, ZGET35, ZGET36, ZGET37, ZGET38
57 * ..
58 * .. External Functions ..
59 DOUBLE PRECISION DLAMCH
60 EXTERNAL DLAMCH
61 * ..
62 * .. Executable Statements ..
63 *
64 PATH( 1: 1 ) = 'Zomplex precision'
65 PATH( 2: 3 ) = 'EC'
66 EPS = DLAMCH( 'P' )
67 SFMIN = DLAMCH( 'S' )
68 WRITE( NOUT, FMT = 9994 )
69 WRITE( NOUT, FMT = 9993 )EPS, SFMIN
70 WRITE( NOUT, FMT = 9992 )THRESH
71 *
72 * Test error exits if TSTERR is .TRUE.
73 *
74 IF( TSTERR )
75 $ CALL ZERREC( PATH, NOUT )
76 *
77 OK = .TRUE.
78 CALL ZGET35( RTRSYL, LTRSYL, NTRSYL, KTRSYL, NIN )
79 IF( RTRSYL.GT.THRESH ) THEN
80 OK = .FALSE.
81 WRITE( NOUT, FMT = 9999 )RTRSYL, LTRSYL, NTRSYL, KTRSYL
82 END IF
83 *
84 CALL ZGET36( RTREXC, LTREXC, NTREXC, KTREXC, NIN )
85 IF( RTREXC.GT.THRESH .OR. NTREXC.GT.0 ) THEN
86 OK = .FALSE.
87 WRITE( NOUT, FMT = 9998 )RTREXC, LTREXC, NTREXC, KTREXC
88 END IF
89 *
90 CALL ZGET37( RTRSNA, LTRSNA, NTRSNA, KTRSNA, NIN )
91 IF( RTRSNA( 1 ).GT.THRESH .OR. RTRSNA( 2 ).GT.THRESH .OR.
92 $ NTRSNA( 1 ).NE.0 .OR. NTRSNA( 2 ).NE.0 .OR. NTRSNA( 3 ).NE.0 )
93 $ THEN
94 OK = .FALSE.
95 WRITE( NOUT, FMT = 9997 )RTRSNA, LTRSNA, NTRSNA, KTRSNA
96 END IF
97 *
98 CALL ZGET38( RTRSEN, LTRSEN, NTRSEN, KTRSEN, NIN )
99 IF( RTRSEN( 1 ).GT.THRESH .OR. RTRSEN( 2 ).GT.THRESH .OR.
100 $ NTRSEN( 1 ).NE.0 .OR. NTRSEN( 2 ).NE.0 .OR. NTRSEN( 3 ).NE.0 )
101 $ THEN
102 OK = .FALSE.
103 WRITE( NOUT, FMT = 9996 )RTRSEN, LTRSEN, NTRSEN, KTRSEN
104 END IF
105 *
106 NTESTS = KTRSYL + KTREXC + KTRSNA + KTRSEN
107 IF( OK )
108 $ WRITE( NOUT, FMT = 9995 )PATH, NTESTS
109 *
110 9999 FORMAT( ' Error in ZTRSYL: RMAX =', D12.3, / ' LMAX = ', I8,
111 $ ' NINFO=', I8, ' KNT=', I8 )
112 9998 FORMAT( ' Error in ZTREXC: RMAX =', D12.3, / ' LMAX = ', I8,
113 $ ' NINFO=', I8, ' KNT=', I8 )
114 9997 FORMAT( ' Error in ZTRSNA: RMAX =', 3D12.3, / ' LMAX = ', 3I8,
115 $ ' NINFO=', 3I8, ' KNT=', I8 )
116 9996 FORMAT( ' Error in ZTRSEN: RMAX =', 3D12.3, / ' LMAX = ', 3I8,
117 $ ' NINFO=', 3I8, ' KNT=', I8 )
118 9995 FORMAT( / 1X, 'All tests for ', A3,
119 $ ' routines passed the threshold (', I6, ' tests run)' )
120 9994 FORMAT( ' Tests of the Nonsymmetric eigenproblem condition',
121 $ ' estimation routines', / ' ZTRSYL, CTREXC, CTRSNA, CTRSEN',
122 $ / )
123 9993 FORMAT( ' Relative machine precision (EPS) = ', D16.6,
124 $ / ' Safe minimum (SFMIN) = ', D16.6, / )
125 9992 FORMAT( ' Routines pass computational tests if test ratio is ',
126 $ 'less than', F8.2, / / )
127 RETURN
128 *
129 * End of ZCHKEC
130 *
131 END