LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
zerrhs.f
Go to the documentation of this file.
1 *> \brief \b ZERRHS
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 ZERRHS( 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 *> ZERRHS tests the error exits for ZGEBAK, CGEBAL, CGEHRD, ZUNGHR,
25 *> ZUNMHR, ZHSEQR, CHSEIN, and ZTREVC.
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 complex16_eig
54 *
55 * =====================================================================
56  SUBROUTINE zerrhs( 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  DOUBLE PRECISION rw( nmax ), s( nmax )
82  COMPLEX*16 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, zgebak, zgebal, zgehrd, zhsein, zhseqr,
92  $ ztrevc, zunghr, zunmhr
93 * ..
94 * .. Intrinsic Functions ..
95  INTRINSIC dble
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.d0 / dble( 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 * ZGEBAL
128 *
129  srnamt = 'ZGEBAL'
130  infot = 1
131  CALL zgebal( '/', 0, a, 1, ilo, ihi, s, info )
132  CALL chkxer( 'ZGEBAL', infot, nout, lerr, ok )
133  infot = 2
134  CALL zgebal( 'N', -1, a, 1, ilo, ihi, s, info )
135  CALL chkxer( 'ZGEBAL', infot, nout, lerr, ok )
136  infot = 4
137  CALL zgebal( 'N', 2, a, 1, ilo, ihi, s, info )
138  CALL chkxer( 'ZGEBAL', infot, nout, lerr, ok )
139  nt = nt + 3
140 *
141 * ZGEBAK
142 *
143  srnamt = 'ZGEBAK'
144  infot = 1
145  CALL zgebak( '/', 'R', 0, 1, 0, s, 0, a, 1, info )
146  CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
147  infot = 2
148  CALL zgebak( 'N', '/', 0, 1, 0, s, 0, a, 1, info )
149  CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
150  infot = 3
151  CALL zgebak( 'N', 'R', -1, 1, 0, s, 0, a, 1, info )
152  CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
153  infot = 4
154  CALL zgebak( 'N', 'R', 0, 0, 0, s, 0, a, 1, info )
155  CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
156  infot = 4
157  CALL zgebak( 'N', 'R', 0, 2, 0, s, 0, a, 1, info )
158  CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
159  infot = 5
160  CALL zgebak( 'N', 'R', 2, 2, 1, s, 0, a, 2, info )
161  CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
162  infot = 5
163  CALL zgebak( 'N', 'R', 0, 1, 1, s, 0, a, 1, info )
164  CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
165  infot = 7
166  CALL zgebak( 'N', 'R', 0, 1, 0, s, -1, a, 1, info )
167  CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
168  infot = 9
169  CALL zgebak( 'N', 'R', 2, 1, 2, s, 0, a, 1, info )
170  CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
171  nt = nt + 9
172 *
173 * ZGEHRD
174 *
175  srnamt = 'ZGEHRD'
176  infot = 1
177  CALL zgehrd( -1, 1, 1, a, 1, tau, w, 1, info )
178  CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
179  infot = 2
180  CALL zgehrd( 0, 0, 0, a, 1, tau, w, 1, info )
181  CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
182  infot = 2
183  CALL zgehrd( 0, 2, 0, a, 1, tau, w, 1, info )
184  CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
185  infot = 3
186  CALL zgehrd( 1, 1, 0, a, 1, tau, w, 1, info )
187  CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
188  infot = 3
189  CALL zgehrd( 0, 1, 1, a, 1, tau, w, 1, info )
190  CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
191  infot = 5
192  CALL zgehrd( 2, 1, 1, a, 1, tau, w, 2, info )
193  CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
194  infot = 8
195  CALL zgehrd( 2, 1, 2, a, 2, tau, w, 1, info )
196  CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
197  nt = nt + 7
198 *
199 * ZUNGHR
200 *
201  srnamt = 'ZUNGHR'
202  infot = 1
203  CALL zunghr( -1, 1, 1, a, 1, tau, w, 1, info )
204  CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
205  infot = 2
206  CALL zunghr( 0, 0, 0, a, 1, tau, w, 1, info )
207  CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
208  infot = 2
209  CALL zunghr( 0, 2, 0, a, 1, tau, w, 1, info )
210  CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
211  infot = 3
212  CALL zunghr( 1, 1, 0, a, 1, tau, w, 1, info )
213  CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
214  infot = 3
215  CALL zunghr( 0, 1, 1, a, 1, tau, w, 1, info )
216  CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
217  infot = 5
218  CALL zunghr( 2, 1, 1, a, 1, tau, w, 1, info )
219  CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
220  infot = 8
221  CALL zunghr( 3, 1, 3, a, 3, tau, w, 1, info )
222  CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
223  nt = nt + 7
224 *
225 * ZUNMHR
226 *
227  srnamt = 'ZUNMHR'
228  infot = 1
229  CALL zunmhr( '/', 'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
230  $ info )
231  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
232  infot = 2
233  CALL zunmhr( 'L', '/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
234  $ info )
235  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
236  infot = 3
237  CALL zunmhr( 'L', 'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
238  $ info )
239  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
240  infot = 4
241  CALL zunmhr( 'L', 'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
242  $ info )
243  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
244  infot = 5
245  CALL zunmhr( 'L', 'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
246  $ info )
247  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
248  infot = 5
249  CALL zunmhr( 'L', 'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
250  $ info )
251  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
252  infot = 5
253  CALL zunmhr( 'L', 'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
254  $ info )
255  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
256  infot = 5
257  CALL zunmhr( 'R', 'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
258  $ info )
259  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
260  infot = 6
261  CALL zunmhr( 'L', 'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
262  $ info )
263  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
264  infot = 6
265  CALL zunmhr( 'L', 'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
266  $ info )
267  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
268  infot = 6
269  CALL zunmhr( 'R', 'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
270  $ info )
271  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
272  infot = 8
273  CALL zunmhr( 'L', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
274  $ info )
275  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
276  infot = 8
277  CALL zunmhr( 'R', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
278  $ info )
279  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
280  infot = 11
281  CALL zunmhr( 'L', 'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
282  $ info )
283  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
284  infot = 13
285  CALL zunmhr( 'L', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
286  $ info )
287  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
288  infot = 13
289  CALL zunmhr( 'R', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
290  $ info )
291  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
292  nt = nt + 16
293 *
294 * ZHSEQR
295 *
296  srnamt = 'ZHSEQR'
297  infot = 1
298  CALL zhseqr( '/', 'N', 0, 1, 0, a, 1, x, c, 1, w, 1, info )
299  CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
300  infot = 2
301  CALL zhseqr( 'E', '/', 0, 1, 0, a, 1, x, c, 1, w, 1, info )
302  CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
303  infot = 3
304  CALL zhseqr( 'E', 'N', -1, 1, 0, a, 1, x, c, 1, w, 1, info )
305  CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
306  infot = 4
307  CALL zhseqr( 'E', 'N', 0, 0, 0, a, 1, x, c, 1, w, 1, info )
308  CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
309  infot = 4
310  CALL zhseqr( 'E', 'N', 0, 2, 0, a, 1, x, c, 1, w, 1, info )
311  CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
312  infot = 5
313  CALL zhseqr( 'E', 'N', 1, 1, 0, a, 1, x, c, 1, w, 1, info )
314  CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
315  infot = 5
316  CALL zhseqr( 'E', 'N', 1, 1, 2, a, 1, x, c, 1, w, 1, info )
317  CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
318  infot = 7
319  CALL zhseqr( 'E', 'N', 2, 1, 2, a, 1, x, c, 2, w, 1, info )
320  CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
321  infot = 10
322  CALL zhseqr( 'E', 'V', 2, 1, 2, a, 2, x, c, 1, w, 1, info )
323  CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
324  nt = nt + 9
325 *
326 * ZHSEIN
327 *
328  srnamt = 'ZHSEIN'
329  infot = 1
330  CALL zhsein( '/', 'N', 'N', sel, 0, a, 1, x, vl, 1, vr, 1, 0,
331  $ m, w, rw, ifaill, ifailr, info )
332  CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
333  infot = 2
334  CALL zhsein( 'R', '/', 'N', sel, 0, a, 1, x, vl, 1, vr, 1, 0,
335  $ m, w, rw, ifaill, ifailr, info )
336  CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
337  infot = 3
338  CALL zhsein( 'R', 'N', '/', sel, 0, a, 1, x, vl, 1, vr, 1, 0,
339  $ m, w, rw, ifaill, ifailr, info )
340  CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
341  infot = 5
342  CALL zhsein( 'R', 'N', 'N', sel, -1, a, 1, x, vl, 1, vr, 1, 0,
343  $ m, w, rw, ifaill, ifailr, info )
344  CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
345  infot = 7
346  CALL zhsein( 'R', 'N', 'N', sel, 2, a, 1, x, vl, 1, vr, 2, 4,
347  $ m, w, rw, ifaill, ifailr, info )
348  CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
349  infot = 10
350  CALL zhsein( 'L', 'N', 'N', sel, 2, a, 2, x, vl, 1, vr, 1, 4,
351  $ m, w, rw, ifaill, ifailr, info )
352  CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
353  infot = 12
354  CALL zhsein( 'R', 'N', 'N', sel, 2, a, 2, x, vl, 1, vr, 1, 4,
355  $ m, w, rw, ifaill, ifailr, info )
356  CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
357  infot = 13
358  CALL zhsein( 'R', 'N', 'N', sel, 2, a, 2, x, vl, 1, vr, 2, 1,
359  $ m, w, rw, ifaill, ifailr, info )
360  CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
361  nt = nt + 8
362 *
363 * ZTREVC
364 *
365  srnamt = 'ZTREVC'
366  infot = 1
367  CALL ztrevc( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w, rw,
368  $ info )
369  CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
370  infot = 2
371  CALL ztrevc( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w, rw,
372  $ info )
373  CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
374  infot = 4
375  CALL ztrevc( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
376  $ rw, info )
377  CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
378  infot = 6
379  CALL ztrevc( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w, rw,
380  $ info )
381  CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
382  infot = 8
383  CALL ztrevc( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w, rw,
384  $ info )
385  CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
386  infot = 10
387  CALL ztrevc( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w, rw,
388  $ info )
389  CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
390  infot = 11
391  CALL ztrevc( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w, rw,
392  $ info )
393  CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
394  nt = nt + 7
395  END IF
396 *
397 * Print a summary line.
398 *
399  IF( ok ) THEN
400  WRITE( nout, fmt = 9999 )path, nt
401  ELSE
402  WRITE( nout, fmt = 9998 )path
403  END IF
404 *
405  9999 format( 1x, a3, ' routines passed the tests of the error exits',
406  $ ' (', i3, ' tests done)' )
407  9998 format( ' *** ', a3, ' routines failed the tests of the error ',
408  $ 'exits ***' )
409 *
410  return
411 *
412 * End of ZERRHS
413 *
414  END