LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
cerrhs.f
Go to the documentation of this file.
1 *> \brief \b CERRHS
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 CERRHS( PATH, NUNIT )
12 *
13 * .. Scalar Arguments ..
14 * CHARACTER*3 PATH
15 * INTEGER NUNIT
16 * ..
17 *
18 *
19 *> \par Purpose:
20 * =============
21 *>
22 *> \verbatim
23 *>
24 *> CERRHS tests the error exits for CGEBAK, CGEBAL, CGEHRD, CUNGHR,
25 *> CUNMHR, CHSEQR, CHSEIN, and CTREVC.
26 *> \endverbatim
27 *
28 * Arguments:
29 * ==========
30 *
31 *> \param[in] PATH
32 *> \verbatim
33 *> PATH is CHARACTER*3
34 *> The LAPACK path name for the routines to be tested.
35 *> \endverbatim
36 *>
37 *> \param[in] NUNIT
38 *> \verbatim
39 *> NUNIT is INTEGER
40 *> The unit number for output.
41 *> \endverbatim
42 *
43 * Authors:
44 * ========
45 *
46 *> \author Univ. of Tennessee
47 *> \author Univ. of California Berkeley
48 *> \author Univ. of Colorado Denver
49 *> \author NAG Ltd.
50 *
51 *> \date November 2011
52 *
53 *> \ingroup complex_eig
54 *
55 * =====================================================================
56  SUBROUTINE cerrhs( PATH, NUNIT )
57 *
58 * -- LAPACK test routine (version 3.4.0) --
59 * -- LAPACK is a software package provided by Univ. of Tennessee, --
60 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61 * November 2011
62 *
63 * .. Scalar Arguments ..
64  CHARACTER*3 path
65  INTEGER nunit
66 * ..
67 *
68 * =====================================================================
69 *
70 * .. Parameters ..
71  INTEGER nmax, lw
72  parameter( nmax = 3, lw = nmax*nmax )
73 * ..
74 * .. Local Scalars ..
75  CHARACTER*2 c2
76  INTEGER i, ihi, ilo, info, j, m, nt
77 * ..
78 * .. Local Arrays ..
79  LOGICAL sel( nmax )
80  INTEGER ifaill( nmax ), ifailr( nmax )
81  REAL rw( nmax ), s( nmax )
82  COMPLEX a( nmax, nmax ), c( nmax, nmax ), tau( nmax ),
83  $ vl( nmax, nmax ), vr( nmax, nmax ), w( lw ),
84  $ x( nmax )
85 * ..
86 * .. External Functions ..
87  LOGICAL lsamen
88  EXTERNAL lsamen
89 * ..
90 * .. External Subroutines ..
91  EXTERNAL chkxer, cgebak, cgebal, cgehrd, chsein, chseqr,
92  $ cunghr, cunmhr, ctrevc
93 * ..
94 * .. Intrinsic Functions ..
95  INTRINSIC real
96 * ..
97 * .. Scalars in Common ..
98  LOGICAL lerr, ok
99  CHARACTER*32 srnamt
100  INTEGER infot, nout
101 * ..
102 * .. Common blocks ..
103  common / infoc / infot, nout, ok, lerr
104  common / srnamc / srnamt
105 * ..
106 * .. Executable Statements ..
107 *
108  nout = nunit
109  WRITE( nout, fmt = * )
110  c2 = path( 2: 3 )
111 *
112 * Set the variables to innocuous values.
113 *
114  DO 20 j = 1, nmax
115  DO 10 i = 1, nmax
116  a( i, j ) = 1. / REAL( i+j )
117  10 continue
118  sel( j ) = .true.
119  20 continue
120  ok = .true.
121  nt = 0
122 *
123 * Test error exits of the nonsymmetric eigenvalue routines.
124 *
125  IF( lsamen( 2, c2, 'HS' ) ) THEN
126 *
127 * CGEBAL
128 *
129  srnamt = 'CGEBAL'
130  infot = 1
131  CALL cgebal( '/', 0, a, 1, ilo, ihi, s, info )
132  CALL chkxer( 'CGEBAL', infot, nout, lerr, ok )
133  infot = 2
134  CALL cgebal( 'N', -1, a, 1, ilo, ihi, s, info )
135  CALL chkxer( 'CGEBAL', infot, nout, lerr, ok )
136  infot = 4
137  CALL cgebal( 'N', 2, a, 1, ilo, ihi, s, info )
138  CALL chkxer( 'CGEBAL', infot, nout, lerr, ok )
139  nt = nt + 3
140 *
141 * CGEBAK
142 *
143  srnamt = 'CGEBAK'
144  infot = 1
145  CALL cgebak( '/', 'R', 0, 1, 0, s, 0, a, 1, info )
146  CALL chkxer( 'CGEBAK', infot, nout, lerr, ok )
147  infot = 2
148  CALL cgebak( 'N', '/', 0, 1, 0, s, 0, a, 1, info )
149  CALL chkxer( 'CGEBAK', infot, nout, lerr, ok )
150  infot = 3
151  CALL cgebak( 'N', 'R', -1, 1, 0, s, 0, a, 1, info )
152  CALL chkxer( 'CGEBAK', infot, nout, lerr, ok )
153  infot = 4
154  CALL cgebak( 'N', 'R', 0, 0, 0, s, 0, a, 1, info )
155  CALL chkxer( 'CGEBAK', infot, nout, lerr, ok )
156  infot = 4
157  CALL cgebak( 'N', 'R', 0, 2, 0, s, 0, a, 1, info )
158  CALL chkxer( 'CGEBAK', infot, nout, lerr, ok )
159  infot = 5
160  CALL cgebak( 'N', 'R', 2, 2, 1, s, 0, a, 2, info )
161  CALL chkxer( 'CGEBAK', infot, nout, lerr, ok )
162  infot = 5
163  CALL cgebak( 'N', 'R', 0, 1, 1, s, 0, a, 1, info )
164  CALL chkxer( 'CGEBAK', infot, nout, lerr, ok )
165  infot = 7
166  CALL cgebak( 'N', 'R', 0, 1, 0, s, -1, a, 1, info )
167  CALL chkxer( 'CGEBAK', infot, nout, lerr, ok )
168  infot = 9
169  CALL cgebak( 'N', 'R', 2, 1, 2, s, 0, a, 1, info )
170  CALL chkxer( 'CGEBAK', infot, nout, lerr, ok )
171  nt = nt + 9
172 *
173 * CGEHRD
174 *
175  srnamt = 'CGEHRD'
176  infot = 1
177  CALL cgehrd( -1, 1, 1, a, 1, tau, w, 1, info )
178  CALL chkxer( 'CGEHRD', infot, nout, lerr, ok )
179  infot = 2
180  CALL cgehrd( 0, 0, 0, a, 1, tau, w, 1, info )
181  CALL chkxer( 'CGEHRD', infot, nout, lerr, ok )
182  infot = 2
183  CALL cgehrd( 0, 2, 0, a, 1, tau, w, 1, info )
184  CALL chkxer( 'CGEHRD', infot, nout, lerr, ok )
185  infot = 3
186  CALL cgehrd( 1, 1, 0, a, 1, tau, w, 1, info )
187  CALL chkxer( 'CGEHRD', infot, nout, lerr, ok )
188  infot = 3
189  CALL cgehrd( 0, 1, 1, a, 1, tau, w, 1, info )
190  CALL chkxer( 'CGEHRD', infot, nout, lerr, ok )
191  infot = 5
192  CALL cgehrd( 2, 1, 1, a, 1, tau, w, 2, info )
193  CALL chkxer( 'CGEHRD', infot, nout, lerr, ok )
194  infot = 8
195  CALL cgehrd( 2, 1, 2, a, 2, tau, w, 1, info )
196  CALL chkxer( 'CGEHRD', infot, nout, lerr, ok )
197  nt = nt + 7
198 *
199 * CUNGHR
200 *
201  srnamt = 'CUNGHR'
202  infot = 1
203  CALL cunghr( -1, 1, 1, a, 1, tau, w, 1, info )
204  CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
205  infot = 2
206  CALL cunghr( 0, 0, 0, a, 1, tau, w, 1, info )
207  CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
208  infot = 2
209  CALL cunghr( 0, 2, 0, a, 1, tau, w, 1, info )
210  CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
211  infot = 3
212  CALL cunghr( 1, 1, 0, a, 1, tau, w, 1, info )
213  CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
214  infot = 3
215  CALL cunghr( 0, 1, 1, a, 1, tau, w, 1, info )
216  CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
217  infot = 5
218  CALL cunghr( 2, 1, 1, a, 1, tau, w, 1, info )
219  CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
220  infot = 8
221  CALL cunghr( 3, 1, 3, a, 3, tau, w, 1, info )
222  CALL chkxer( 'CUNGHR', infot, nout, lerr, ok )
223  nt = nt + 7
224 *
225 * CUNMHR
226 *
227  srnamt = 'CUNMHR'
228  infot = 1
229  CALL cunmhr( '/', 'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
230  $ info )
231  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
232  infot = 2
233  CALL cunmhr( 'L', '/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
234  $ info )
235  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
236  infot = 3
237  CALL cunmhr( 'L', 'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
238  $ info )
239  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
240  infot = 4
241  CALL cunmhr( 'L', 'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
242  $ info )
243  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
244  infot = 5
245  CALL cunmhr( 'L', 'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
246  $ info )
247  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
248  infot = 5
249  CALL cunmhr( 'L', 'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
250  $ info )
251  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
252  infot = 5
253  CALL cunmhr( 'L', 'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
254  $ info )
255  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
256  infot = 5
257  CALL cunmhr( 'R', 'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
258  $ info )
259  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
260  infot = 6
261  CALL cunmhr( 'L', 'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
262  $ info )
263  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
264  infot = 6
265  CALL cunmhr( 'L', 'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
266  $ info )
267  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
268  infot = 6
269  CALL cunmhr( 'R', 'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
270  $ info )
271  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
272  infot = 8
273  CALL cunmhr( 'L', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
274  $ info )
275  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
276  infot = 8
277  CALL cunmhr( 'R', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
278  $ info )
279  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
280  infot = 11
281  CALL cunmhr( 'L', 'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
282  $ info )
283  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
284  infot = 13
285  CALL cunmhr( 'L', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
286  $ info )
287  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
288  infot = 13
289  CALL cunmhr( 'R', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
290  $ info )
291  CALL chkxer( 'CUNMHR', infot, nout, lerr, ok )
292  nt = nt + 16
293 *
294 * CHSEQR
295 *
296  srnamt = 'CHSEQR'
297  infot = 1
298  CALL chseqr( '/', 'N', 0, 1, 0, a, 1, x, c, 1, w, 1,
299  $ info )
300  CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
301  infot = 2
302  CALL chseqr( 'E', '/', 0, 1, 0, a, 1, x, c, 1, w, 1,
303  $ info )
304  CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
305  infot = 3
306  CALL chseqr( 'E', 'N', -1, 1, 0, a, 1, x, c, 1, w, 1,
307  $ info )
308  CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
309  infot = 4
310  CALL chseqr( 'E', 'N', 0, 0, 0, a, 1, x, c, 1, w, 1,
311  $ info )
312  CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
313  infot = 4
314  CALL chseqr( 'E', 'N', 0, 2, 0, a, 1, x, c, 1, w, 1,
315  $ info )
316  CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
317  infot = 5
318  CALL chseqr( 'E', 'N', 1, 1, 0, a, 1, x, c, 1, w, 1,
319  $ info )
320  CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
321  infot = 5
322  CALL chseqr( 'E', 'N', 1, 1, 2, a, 1, x, c, 1, w, 1,
323  $ info )
324  CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
325  infot = 7
326  CALL chseqr( 'E', 'N', 2, 1, 2, a, 1, x, c, 2, w, 1,
327  $ info )
328  CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
329  infot = 10
330  CALL chseqr( 'E', 'V', 2, 1, 2, a, 2, x, c, 1, w, 1,
331  $ info )
332  CALL chkxer( 'CHSEQR', infot, nout, lerr, ok )
333  nt = nt + 9
334 *
335 * CHSEIN
336 *
337  srnamt = 'CHSEIN'
338  infot = 1
339  CALL chsein( '/', 'N', 'N', sel, 0, a, 1, x, vl, 1, vr, 1,
340  $ 0, m, w, rw, ifaill, ifailr, info )
341  CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
342  infot = 2
343  CALL chsein( 'R', '/', 'N', sel, 0, a, 1, x, vl, 1, vr, 1,
344  $ 0, m, w, rw, ifaill, ifailr, info )
345  CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
346  infot = 3
347  CALL chsein( 'R', 'N', '/', sel, 0, a, 1, x, vl, 1, vr, 1,
348  $ 0, m, w, rw, ifaill, ifailr, info )
349  CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
350  infot = 5
351  CALL chsein( 'R', 'N', 'N', sel, -1, a, 1, x, vl, 1, vr,
352  $ 1, 0, m, w, rw, ifaill, ifailr, info )
353  CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
354  infot = 7
355  CALL chsein( 'R', 'N', 'N', sel, 2, a, 1, x, vl, 1, vr, 2,
356  $ 4, m, w, rw, ifaill, ifailr, info )
357  CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
358  infot = 10
359  CALL chsein( 'L', 'N', 'N', sel, 2, a, 2, x, vl, 1, vr, 1,
360  $ 4, m, w, rw, ifaill, ifailr, info )
361  CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
362  infot = 12
363  CALL chsein( 'R', 'N', 'N', sel, 2, a, 2, x, vl, 1, vr, 1,
364  $ 4, m, w, rw, ifaill, ifailr, info )
365  CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
366  infot = 13
367  CALL chsein( 'R', 'N', 'N', sel, 2, a, 2, x, vl, 1, vr, 2,
368  $ 1, m, w, rw, ifaill, ifailr, info )
369  CALL chkxer( 'CHSEIN', infot, nout, lerr, ok )
370  nt = nt + 8
371 *
372 * CTREVC
373 *
374  srnamt = 'CTREVC'
375  infot = 1
376  CALL ctrevc( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
377  $ rw, info )
378  CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
379  infot = 2
380  CALL ctrevc( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w,
381  $ rw, info )
382  CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
383  infot = 4
384  CALL ctrevc( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
385  $ rw, info )
386  CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
387  infot = 6
388  CALL ctrevc( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w,
389  $ rw, info )
390  CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
391  infot = 8
392  CALL ctrevc( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
393  $ rw, info )
394  CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
395  infot = 10
396  CALL ctrevc( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w,
397  $ rw, info )
398  CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
399  infot = 11
400  CALL ctrevc( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w,
401  $ rw, info )
402  CALL chkxer( 'CTREVC', infot, nout, lerr, ok )
403  nt = nt + 7
404  END IF
405 *
406 * Print a summary line.
407 *
408  IF( ok ) THEN
409  WRITE( nout, fmt = 9999 )path, nt
410  ELSE
411  WRITE( nout, fmt = 9998 )path
412  END IF
413 *
414  9999 format( 1x, a3, ' routines passed the tests of the error exits',
415  $ ' (', i3, ' tests done)' )
416  9998 format( ' *** ', a3, ' routines failed the tests of the error ',
417  $ 'exits ***' )
418 *
419  return
420 *
421 * End of CERRHS
422 *
423  END