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*> \ingroup complex_eig
72*
73*  =====================================================================
74      SUBROUTINE CCHKEC( THRESH, TSTERR, NIN, NOUT )
75*
76*  -- LAPACK test routine --
77*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
78*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
79*
80*     .. Scalar Arguments ..
81      LOGICAL            TSTERR
82      INTEGER            NIN, NOUT
83      REAL               THRESH
84*     ..
85*
86*  =====================================================================
87*
88*     .. Local Scalars ..
89      LOGICAL            OK
90      CHARACTER*3        PATH
91      INTEGER            KTREXC, KTRSEN, KTRSNA, KTRSYL, LTREXC, LTRSYL,
92     $                   NTESTS, NTREXC, NTRSYL
93      REAL               EPS, RTREXC, RTRSYL, SFMIN
94*     ..
95*     .. Local Arrays ..
96      INTEGER            LTRSEN( 3 ), LTRSNA( 3 ), NTRSEN( 3 ),
97     $                   NTRSNA( 3 )
98      REAL               RTRSEN( 3 ), RTRSNA( 3 )
99*     ..
100*     .. External Subroutines ..
101      EXTERNAL           CERREC, CGET35, CGET36, CGET37, CGET38
102*     ..
103*     .. External Functions ..
104      REAL               SLAMCH
105      EXTERNAL           SLAMCH
106*     ..
107*     .. Executable Statements ..
108*
109      PATH( 1: 1 ) = 'Complex precision'
110      PATH( 2: 3 ) = 'EC'
111      EPS = SLAMCH( 'P' )
112      SFMIN = SLAMCH( 'S' )
113      WRITE( NOUT, FMT = 9994 )
114      WRITE( NOUT, FMT = 9993 )EPS, SFMIN
115      WRITE( NOUT, FMT = 9992 )THRESH
116*
117*     Test error exits if TSTERR is .TRUE.
118*
119      IF( TSTERR )
120     $   CALL CERREC( PATH, NOUT )
121*
122      OK = .TRUE.
123      CALL CGET35( RTRSYL, LTRSYL, NTRSYL, KTRSYL, NIN )
124      IF( RTRSYL.GT.THRESH ) THEN
125         OK = .FALSE.
126         WRITE( NOUT, FMT = 9999 )RTRSYL, LTRSYL, NTRSYL, KTRSYL
127      END IF
128*
129      CALL CGET36( RTREXC, LTREXC, NTREXC, KTREXC, NIN )
130      IF( RTREXC.GT.THRESH .OR. NTREXC.GT.0 ) THEN
131         OK = .FALSE.
132         WRITE( NOUT, FMT = 9998 )RTREXC, LTREXC, NTREXC, KTREXC
133      END IF
134*
135      CALL CGET37( RTRSNA, LTRSNA, NTRSNA, KTRSNA, NIN )
136      IF( RTRSNA( 1 ).GT.THRESH .OR. RTRSNA( 2 ).GT.THRESH .OR.
137     $    NTRSNA( 1 ).NE.0 .OR. NTRSNA( 2 ).NE.0 .OR. NTRSNA( 3 ).NE.0 )
138     $     THEN
139         OK = .FALSE.
140         WRITE( NOUT, FMT = 9997 )RTRSNA, LTRSNA, NTRSNA, KTRSNA
141      END IF
142*
143      CALL CGET38( RTRSEN, LTRSEN, NTRSEN, KTRSEN, NIN )
144      IF( RTRSEN( 1 ).GT.THRESH .OR. RTRSEN( 2 ).GT.THRESH .OR.
145     $    NTRSEN( 1 ).NE.0 .OR. NTRSEN( 2 ).NE.0 .OR. NTRSEN( 3 ).NE.0 )
146     $     THEN
147         OK = .FALSE.
148         WRITE( NOUT, FMT = 9996 )RTRSEN, LTRSEN, NTRSEN, KTRSEN
149      END IF
150*
151      NTESTS = KTRSYL + KTREXC + KTRSNA + KTRSEN
152      IF( OK )
153     $   WRITE( NOUT, FMT = 9995 )PATH, NTESTS
154*
155 9999 FORMAT( ' Error in CTRSYL: RMAX =', E12.3, / ' LMAX = ', I8,
156     $      ' NINFO=', I8, ' KNT=', I8 )
157 9998 FORMAT( ' Error in CTREXC: RMAX =', E12.3, / ' LMAX = ', I8,
158     $      ' NINFO=', I8, ' KNT=', I8 )
159 9997 FORMAT( ' Error in CTRSNA: RMAX =', 3E12.3, / ' LMAX = ',
160     $      3I8, ' NINFO=', 3I8, ' KNT=', I8 )
161 9996 FORMAT( ' Error in CTRSEN: RMAX =', 3E12.3, / ' LMAX = ',
162     $      3I8, ' NINFO=', 3I8, ' KNT=', I8 )
163 9995 FORMAT( / 1X, 'All tests for ', A3,
164     $      ' routines passed the threshold ( ', I6, ' tests run)' )
165 9994 FORMAT( ' Tests of the Nonsymmetric eigenproblem condition',
166     $      ' estimation routines', / ' CTRSYL, CTREXC, CTRSNA, CTRSEN',
167     $      / )
168 9993 FORMAT( ' Relative machine precision (EPS) = ', E16.6,
169     $      / ' Safe minimum (SFMIN)             = ', E16.6, / )
170 9992 FORMAT( ' Routines pass computational tests if test ratio is ',
171     $      'less than', F8.2, / / )
172      RETURN
173*
174*     End of CCHKEC
175*
176      END
177