LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
schkec.f
Go to the documentation of this file.
1 *> \brief \b SCHKEC
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 SCHKEC( 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 *> SCHKEC tests eigen- condition estimation routines
26 *> SLALN2, SLASY2, SLANV2, SLAQTR, SLAEXC,
27 *> STRSYL, STREXC, STRSNA, STRSEN
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, STREXC, STRSNA and STRSEN
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 REAL
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 single_eig
75 *
76 * =====================================================================
77  SUBROUTINE schkec( 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  REAL 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  REAL 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  REAL RTRSEN( 3 ), RTRSNA( 3 )
107 * ..
108 * .. External Subroutines ..
109  EXTERNAL serrec, sget31, sget32, sget33, sget34, sget35,
111 * ..
112 * .. External Functions ..
113  REAL SLAMCH
114  EXTERNAL slamch
115 * ..
116 * .. Executable Statements ..
117 *
118  path( 1: 1 ) = 'Single precision'
119  path( 2: 3 ) = 'EC'
120  eps = slamch( 'P' )
121  sfmin = slamch( 'S' )
122 *
123 * Print header information
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 serrec( path, nout )
133 *
134  ok = .true.
135  CALL sget31( 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 sget32( 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 sget33( 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 sget34( 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 sget35( 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 sget36( 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 sget37( 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 sget38( 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 sget39( 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 SLALN2: RMAX =', e12.3, / ' LMAX = ', i8, ' N',
200  $ 'INFO=', 2i8, ' KNT=', i8 )
201  9998 FORMAT( ' Error in SLASY2: RMAX =', e12.3, / ' LMAX = ', i8, ' N',
202  $ 'INFO=', i8, ' KNT=', i8 )
203  9997 FORMAT( ' Error in SLANV2: RMAX =', e12.3, / ' LMAX = ', i8, ' N',
204  $ 'INFO=', i8, ' KNT=', i8 )
205  9996 FORMAT( ' Error in SLAEXC: RMAX =', e12.3, / ' LMAX = ', i8, ' N',
206  $ 'INFO=', 2i8, ' KNT=', i8 )
207  9995 FORMAT( ' Error in STRSYL: RMAX =', e12.3, / ' LMAX = ', i8, ' N',
208  $ 'INFO=', i8, ' KNT=', i8 )
209  9994 FORMAT( ' Error in STREXC: RMAX =', e12.3, / ' LMAX = ', i8, ' N',
210  $ 'INFO=', 3i8, ' KNT=', i8 )
211  9993 FORMAT( ' Error in STRSNA: RMAX =', 3e12.3, / ' LMAX = ', 3i8,
212  $ ' NINFO=', 3i8, ' KNT=', i8 )
213  9992 FORMAT( ' Error in STRSEN: RMAX =', 3e12.3, / ' LMAX = ', 3i8,
214  $ ' NINFO=', 3i8, ' KNT=', i8 )
215  9991 FORMAT( ' Error in SLAQTR: RMAX =', e12.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', / ' SLALN2, SLASY2, SLANV2, SLAEXC, STRS',
221  $ 'YL, STREXC, STRSNA, STRSEN, SLAQTR', / )
222  9988 FORMAT( ' Relative machine precision (EPS) = ', e16.6, / ' Safe ',
223  $ 'minimum (SFMIN) = ', e16.6, / )
224  9987 FORMAT( ' Routines pass computational tests if test ratio is les',
225  $ 's than', f8.2, / / )
226 *
227 * End of SCHKEC
228 *
229  END
subroutine serrec(PATH, NUNIT)
SERREC
Definition: serrec.f:58
subroutine sget38(RMAX, LMAX, NINFO, KNT, NIN)
SGET38
Definition: sget38.f:93
subroutine schkec(THRESH, TSTERR, NIN, NOUT)
SCHKEC
Definition: schkec.f:78
subroutine sget31(RMAX, LMAX, NINFO, KNT)
SGET31
Definition: sget31.f:93
subroutine sget37(RMAX, LMAX, NINFO, KNT, NIN)
SGET37
Definition: sget37.f:92
subroutine sget35(RMAX, LMAX, NINFO, KNT)
SGET35
Definition: sget35.f:80
subroutine sget33(RMAX, LMAX, NINFO, KNT)
SGET33
Definition: sget33.f:78
subroutine sget39(RMAX, LMAX, NINFO, KNT)
SGET39
Definition: sget39.f:105
subroutine sget32(RMAX, LMAX, NINFO, KNT)
SGET32
Definition: sget32.f:84
subroutine sget34(RMAX, LMAX, NINFO, KNT)
SGET34
Definition: sget34.f:84
subroutine sget36(RMAX, LMAX, NINFO, KNT, NIN)
SGET36
Definition: sget36.f:90