LAPACK  3.4.2 LAPACK: Linear Algebra PACKage
dchkec.f
Go to the documentation of this file.
1 *> \brief \b DCHKEC
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 DCHKEC( THRESH, TSTERR, NIN, NOUT )
12 *
13 * .. Scalar Arguments ..
14 * LOGICAL TSTERR
15 * INTEGER NIN, NOUT
16 * DOUBLE PRECISION THRESH
17 * ..
18 *
19 *
20 *> \par Purpose:
21 * =============
22 *>
23 *> \verbatim
24 *>
25 *> DCHKEC tests eigen- condition estimation routines
26 *> DLALN2, DLASY2, DLANV2, DLAQTR, DLAEXC,
27 *> DTRSYL, DTREXC, DTRSNA, DTRSEN
28 *>
29 *> In all cases, the routine runs through a fixed set of numerical
30 *> examples, subjects them to various tests, and compares the test
31 *> results to a threshold THRESH. In addition, DTREXC, DTRSNA and DTRSEN
32 *> are tested by reading in precomputed examples from a file (on input
33 *> unit NIN). Output is written to output unit NOUT.
34 *> \endverbatim
35 *
36 * Arguments:
37 * ==========
38 *
39 *> \param[in] THRESH
40 *> \verbatim
41 *> THRESH is DOUBLE PRECISION
42 *> Threshold for residual tests. A computed test ratio passes
43 *> the threshold if it is less than THRESH.
44 *> \endverbatim
45 *>
46 *> \param[in] TSTERR
47 *> \verbatim
48 *> TSTERR is LOGICAL
49 *> Flag that indicates whether error exits are to be tested.
50 *> \endverbatim
51 *>
52 *> \param[in] NIN
53 *> \verbatim
54 *> NIN is INTEGER
55 *> The logical unit number for input.
56 *> \endverbatim
57 *>
58 *> \param[in] NOUT
59 *> \verbatim
60 *> NOUT is INTEGER
61 *> The logical unit number for output.
62 *> \endverbatim
63 *
64 * Authors:
65 * ========
66 *
67 *> \author Univ. of Tennessee
68 *> \author Univ. of California Berkeley
69 *> \author Univ. of Colorado Denver
70 *> \author NAG Ltd.
71 *
72 *> \date November 2011
73 *
74 *> \ingroup double_eig
75 *
76 * =====================================================================
77  SUBROUTINE dchkec( THRESH, TSTERR, NIN, NOUT )
78 *
79 * -- LAPACK test routine (version 3.4.0) --
80 * -- LAPACK is a software package provided by Univ. of Tennessee, --
81 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
82 * November 2011
83 *
84 * .. Scalar Arguments ..
85  LOGICAL tsterr
86  INTEGER nin, nout
87  DOUBLE PRECISION thresh
88 * ..
89 *
90 * =====================================================================
91 *
92 * .. Local Scalars ..
93  LOGICAL ok
94  CHARACTER*3 path
95  INTEGER klaexc, klaln2, klanv2, klaqtr, klasy2, ktrexc,
96  \$ ktrsen, ktrsna, ktrsyl, llaexc, llaln2, llanv2,
97  \$ llaqtr, llasy2, ltrexc, ltrsyl, nlanv2, nlaqtr,
98  \$ nlasy2, ntests, ntrsyl
99  DOUBLE PRECISION eps, rlaexc, rlaln2, rlanv2, rlaqtr, rlasy2,
100  \$ rtrexc, rtrsyl, sfmin
101 * ..
102 * .. Local Arrays ..
103  INTEGER ltrsen( 3 ), ltrsna( 3 ), nlaexc( 2 ),
104  \$ nlaln2( 2 ), ntrexc( 3 ), ntrsen( 3 ),
105  \$ ntrsna( 3 )
106  DOUBLE PRECISION rtrsen( 3 ), rtrsna( 3 )
107 * ..
108 * .. External Subroutines ..
109  EXTERNAL derrec, dget31, dget32, dget33, dget34, dget35,
111 * ..
112 * .. External Functions ..
113  DOUBLE PRECISION dlamch
114  EXTERNAL dlamch
115 * ..
116 * .. Executable Statements ..
117 *
118  path( 1: 1 ) = 'Double precision'
119  path( 2: 3 ) = 'EC'
120  eps = dlamch( 'P' )
121  sfmin = dlamch( 'S' )
122 *
124 *
125  WRITE( nout, fmt = 9989 )
126  WRITE( nout, fmt = 9988 )eps, sfmin
127  WRITE( nout, fmt = 9987 )thresh
128 *
129 * Test error exits if TSTERR is .TRUE.
130 *
131  IF( tsterr )
132  \$ CALL derrec( path, nout )
133 *
134  ok = .true.
135  CALL dget31( rlaln2, llaln2, nlaln2, klaln2 )
136  IF( rlaln2.GT.thresh .OR. nlaln2( 1 ).NE.0 ) THEN
137  ok = .false.
138  WRITE( nout, fmt = 9999 )rlaln2, llaln2, nlaln2, klaln2
139  END IF
140 *
141  CALL dget32( rlasy2, llasy2, nlasy2, klasy2 )
142  IF( rlasy2.GT.thresh ) THEN
143  ok = .false.
144  WRITE( nout, fmt = 9998 )rlasy2, llasy2, nlasy2, klasy2
145  END IF
146 *
147  CALL dget33( rlanv2, llanv2, nlanv2, klanv2 )
148  IF( rlanv2.GT.thresh .OR. nlanv2.NE.0 ) THEN
149  ok = .false.
150  WRITE( nout, fmt = 9997 )rlanv2, llanv2, nlanv2, klanv2
151  END IF
152 *
153  CALL dget34( rlaexc, llaexc, nlaexc, klaexc )
154  IF( rlaexc.GT.thresh .OR. nlaexc( 2 ).NE.0 ) THEN
155  ok = .false.
156  WRITE( nout, fmt = 9996 )rlaexc, llaexc, nlaexc, klaexc
157  END IF
158 *
159  CALL dget35( rtrsyl, ltrsyl, ntrsyl, ktrsyl )
160  IF( rtrsyl.GT.thresh ) THEN
161  ok = .false.
162  WRITE( nout, fmt = 9995 )rtrsyl, ltrsyl, ntrsyl, ktrsyl
163  END IF
164 *
165  CALL dget36( rtrexc, ltrexc, ntrexc, ktrexc, nin )
166  IF( rtrexc.GT.thresh .OR. ntrexc( 3 ).GT.0 ) THEN
167  ok = .false.
168  WRITE( nout, fmt = 9994 )rtrexc, ltrexc, ntrexc, ktrexc
169  END IF
170 *
171  CALL dget37( rtrsna, ltrsna, ntrsna, ktrsna, nin )
172  IF( rtrsna( 1 ).GT.thresh .OR. rtrsna( 2 ).GT.thresh .OR.
173  \$ ntrsna( 1 ).NE.0 .OR. ntrsna( 2 ).NE.0 .OR. ntrsna( 3 ).NE.0 )
174  \$ THEN
175  ok = .false.
176  WRITE( nout, fmt = 9993 )rtrsna, ltrsna, ntrsna, ktrsna
177  END IF
178 *
179  CALL dget38( rtrsen, ltrsen, ntrsen, ktrsen, nin )
180  IF( rtrsen( 1 ).GT.thresh .OR. rtrsen( 2 ).GT.thresh .OR.
181  \$ ntrsen( 1 ).NE.0 .OR. ntrsen( 2 ).NE.0 .OR. ntrsen( 3 ).NE.0 )
182  \$ THEN
183  ok = .false.
184  WRITE( nout, fmt = 9992 )rtrsen, ltrsen, ntrsen, ktrsen
185  END IF
186 *
187  CALL dget39( rlaqtr, llaqtr, nlaqtr, klaqtr )
188  IF( rlaqtr.GT.thresh ) THEN
189  ok = .false.
190  WRITE( nout, fmt = 9991 )rlaqtr, llaqtr, nlaqtr, klaqtr
191  END IF
192 *
193  ntests = klaln2 + klasy2 + klanv2 + klaexc + ktrsyl + ktrexc +
194  \$ ktrsna + ktrsen + klaqtr
195  IF( ok )
196  \$ WRITE( nout, fmt = 9990 )path, ntests
197 *
198  return
199  9999 format( ' Error in DLALN2: RMAX =', d12.3, / ' LMAX = ', i8, ' N',
200  \$ 'INFO=', 2i8, ' KNT=', i8 )
201  9998 format( ' Error in DLASY2: RMAX =', d12.3, / ' LMAX = ', i8, ' N',
202  \$ 'INFO=', i8, ' KNT=', i8 )
203  9997 format( ' Error in DLANV2: RMAX =', d12.3, / ' LMAX = ', i8, ' N',
204  \$ 'INFO=', i8, ' KNT=', i8 )
205  9996 format( ' Error in DLAEXC: RMAX =', d12.3, / ' LMAX = ', i8, ' N',
206  \$ 'INFO=', 2i8, ' KNT=', i8 )
207  9995 format( ' Error in DTRSYL: RMAX =', d12.3, / ' LMAX = ', i8, ' N',
208  \$ 'INFO=', i8, ' KNT=', i8 )
209  9994 format( ' Error in DTREXC: RMAX =', d12.3, / ' LMAX = ', i8, ' N',
210  \$ 'INFO=', 3i8, ' KNT=', i8 )
211  9993 format( ' Error in DTRSNA: RMAX =', 3d12.3, / ' LMAX = ', 3i8,
212  \$ ' NINFO=', 3i8, ' KNT=', i8 )
213  9992 format( ' Error in DTRSEN: RMAX =', 3d12.3, / ' LMAX = ', 3i8,
214  \$ ' NINFO=', 3i8, ' KNT=', i8 )
215  9991 format( ' Error in DLAQTR: RMAX =', d12.3, / ' LMAX = ', i8, ' N',
216  \$ 'INFO=', i8, ' KNT=', i8 )
217  9990 format( / 1x, 'All tests for ', a3, ' routines passed the thresh',
218  \$ 'old ( ', i6, ' tests run)' )
219  9989 format( ' Tests of the Nonsymmetric eigenproblem condition estim',
220  \$ 'ation routines', / ' DLALN2, DLASY2, DLANV2, DLAEXC, DTRS',
221  \$ 'YL, DTREXC, DTRSNA, DTRSEN, DLAQTR', / )
222  9988 format( ' Relative machine precision (EPS) = ', d16.6, / ' Safe ',
223  \$ 'minimum (SFMIN) = ', d16.6, / )
224  9987 format( ' Routines pass computational tests if test ratio is les',
225  \$ 's than', f8.2, / / )
226 *
227 * End of DCHKEC
228 *
229  END