LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
cchkec.f
Go to the documentation of this file.
1 *> \brief \b CCHKEC
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE CCHKEC( THRESH, TSTERR, NIN, NOUT )
12 *
13 * .. Scalar Arguments ..
14 * LOGICAL TSTERR
15 * INTEGER NIN, NOUT
16 * REAL THRESH
17 * ..
18 *
19 *
20 *> \par Purpose:
21 * =============
22 *>
23 *> \verbatim
24 *>
25 *> CCHKEC tests eigen- condition estimation routines
26 *> CTRSYL, CTREXC, CTRSNA, CTRSEN
27 *>
28 *> In all cases, the routine runs through a fixed set of numerical
29 *> examples, subjects them to various tests, and compares the test
30 *> results to a threshold THRESH. In addition, CTRSNA and CTRSEN are
31 *> tested by reading in precomputed examples from a file (on input unit
32 *> NIN). Output is written to output unit NOUT.
33 *> \endverbatim
34 *
35 * Arguments:
36 * ==========
37 *
38 *> \param[in] THRESH
39 *> \verbatim
40 *> THRESH is REAL
41 *> Threshold for residual tests. A computed test ratio passes
42 *> the threshold if it is less than THRESH.
43 *> \endverbatim
44 *>
45 *> \param[in] TSTERR
46 *> \verbatim
47 *> TSTERR is LOGICAL
48 *> Flag that indicates whether error exits are to be tested.
49 *> \endverbatim
50 *>
51 *> \param[in] NIN
52 *> \verbatim
53 *> NIN is INTEGER
54 *> The logical unit number for input.
55 *> \endverbatim
56 *>
57 *> \param[in] NOUT
58 *> \verbatim
59 *> NOUT is INTEGER
60 *> The logical unit number for output.
61 *> \endverbatim
62 *
63 * Authors:
64 * ========
65 *
66 *> \author Univ. of Tennessee
67 *> \author Univ. of California Berkeley
68 *> \author Univ. of Colorado Denver
69 *> \author NAG Ltd.
70 *
71 *> \date November 2011
72 *
73 *> \ingroup complex_eig
74 *
75 * =====================================================================
76  SUBROUTINE cchkec( THRESH, TSTERR, NIN, NOUT )
77 *
78 * -- LAPACK test routine (version 3.4.0) --
79 * -- LAPACK is a software package provided by Univ. of Tennessee, --
80 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
81 * November 2011
82 *
83 * .. Scalar Arguments ..
84  LOGICAL tsterr
85  INTEGER nin, nout
86  REAL thresh
87 * ..
88 *
89 * =====================================================================
90 *
91 * .. Local Scalars ..
92  LOGICAL ok
93  CHARACTER*3 path
94  INTEGER ktrexc, ktrsen, ktrsna, ktrsyl, ltrexc, ltrsyl,
95  $ ntests, ntrexc, ntrsyl
96  REAL eps, rtrexc, rtrsyl, sfmin
97 * ..
98 * .. Local Arrays ..
99  INTEGER ltrsen( 3 ), ltrsna( 3 ), ntrsen( 3 ),
100  $ ntrsna( 3 )
101  REAL rtrsen( 3 ), rtrsna( 3 )
102 * ..
103 * .. External Subroutines ..
104  EXTERNAL cerrec, cget35, cget36, cget37, cget38
105 * ..
106 * .. External Functions ..
107  REAL slamch
108  EXTERNAL slamch
109 * ..
110 * .. Executable Statements ..
111 *
112  path( 1: 1 ) = 'Complex precision'
113  path( 2: 3 ) = 'EC'
114  eps = slamch( 'P' )
115  sfmin = slamch( 'S' )
116  WRITE( nout, fmt = 9994 )
117  WRITE( nout, fmt = 9993 )eps, sfmin
118  WRITE( nout, fmt = 9992 )thresh
119 *
120 * Test error exits if TSTERR is .TRUE.
121 *
122  IF( tsterr )
123  $ CALL cerrec( path, nout )
124 *
125  ok = .true.
126  CALL cget35( rtrsyl, ltrsyl, ntrsyl, ktrsyl, nin )
127  IF( rtrsyl.GT.thresh ) THEN
128  ok = .false.
129  WRITE( nout, fmt = 9999 )rtrsyl, ltrsyl, ntrsyl, ktrsyl
130  END IF
131 *
132  CALL cget36( rtrexc, ltrexc, ntrexc, ktrexc, nin )
133  IF( rtrexc.GT.thresh .OR. ntrexc.GT.0 ) THEN
134  ok = .false.
135  WRITE( nout, fmt = 9998 )rtrexc, ltrexc, ntrexc, ktrexc
136  END IF
137 *
138  CALL cget37( rtrsna, ltrsna, ntrsna, ktrsna, nin )
139  IF( rtrsna( 1 ).GT.thresh .OR. rtrsna( 2 ).GT.thresh .OR.
140  $ ntrsna( 1 ).NE.0 .OR. ntrsna( 2 ).NE.0 .OR. ntrsna( 3 ).NE.0 )
141  $ THEN
142  ok = .false.
143  WRITE( nout, fmt = 9997 )rtrsna, ltrsna, ntrsna, ktrsna
144  END IF
145 *
146  CALL cget38( rtrsen, ltrsen, ntrsen, ktrsen, nin )
147  IF( rtrsen( 1 ).GT.thresh .OR. rtrsen( 2 ).GT.thresh .OR.
148  $ ntrsen( 1 ).NE.0 .OR. ntrsen( 2 ).NE.0 .OR. ntrsen( 3 ).NE.0 )
149  $ THEN
150  ok = .false.
151  WRITE( nout, fmt = 9996 )rtrsen, ltrsen, ntrsen, ktrsen
152  END IF
153 *
154  ntests = ktrsyl + ktrexc + ktrsna + ktrsen
155  IF( ok )
156  $ WRITE( nout, fmt = 9995 )path, ntests
157 *
158  9999 format( ' Error in CTRSYL: RMAX =', e12.3, / ' LMAX = ', i8,
159  $ ' NINFO=', i8, ' KNT=', i8 )
160  9998 format( ' Error in CTREXC: RMAX =', e12.3, / ' LMAX = ', i8,
161  $ ' NINFO=', i8, ' KNT=', i8 )
162  9997 format( ' Error in CTRSNA: RMAX =', 3e12.3, / ' LMAX = ',
163  $ 3i8, ' NINFO=', 3i8, ' KNT=', i8 )
164  9996 format( ' Error in CTRSEN: RMAX =', 3e12.3, / ' LMAX = ',
165  $ 3i8, ' NINFO=', 3i8, ' KNT=', i8 )
166  9995 format( / 1x, 'All tests for ', a3,
167  $ ' routines passed the threshold ( ', i6, ' tests run)' )
168  9994 format( ' Tests of the Nonsymmetric eigenproblem condition',
169  $ ' estimation routines', / ' CTRSYL, CTREXC, CTRSNA, CTRSEN',
170  $ / )
171  9993 format( ' Relative machine precision (EPS) = ', e16.6,
172  $ / ' Safe minimum (SFMIN) = ', e16.6, / )
173  9992 format( ' Routines pass computational tests if test ratio is ',
174  $ 'less than', f8.2, / / )
175  return
176 *
177 * End of CCHKEC
178 *
179  END