LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
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 *> \ingroup complex16_eig
52 *
53 * =====================================================================
54  SUBROUTINE zerrhs( PATH, NUNIT )
55 *
56 * -- LAPACK test routine --
57 * -- LAPACK is a software package provided by Univ. of Tennessee, --
58 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59 *
60 * .. Scalar Arguments ..
61  CHARACTER*3 PATH
62  INTEGER NUNIT
63 * ..
64 *
65 * =====================================================================
66 *
67 * .. Parameters ..
68  INTEGER NMAX, LW
69  parameter( nmax = 3, lw = nmax*nmax )
70 * ..
71 * .. Local Scalars ..
72  CHARACTER*2 C2
73  INTEGER I, IHI, ILO, INFO, J, M, NT
74 * ..
75 * .. Local Arrays ..
76  LOGICAL SEL( NMAX )
77  INTEGER IFAILL( NMAX ), IFAILR( NMAX )
78  DOUBLE PRECISION RW( NMAX ), S( NMAX )
79  COMPLEX*16 A( NMAX, NMAX ), C( NMAX, NMAX ), TAU( NMAX ),
80  $ VL( NMAX, NMAX ), VR( NMAX, NMAX ), W( LW ),
81  $ X( NMAX )
82 * ..
83 * .. External Functions ..
84  LOGICAL LSAMEN
85  EXTERNAL lsamen
86 * ..
87 * .. External Subroutines ..
88  EXTERNAL chkxer, zgebak, zgebal, zgehrd, zhsein, zhseqr,
89  $ ztrevc, zunghr, zunmhr
90 * ..
91 * .. Intrinsic Functions ..
92  INTRINSIC dble
93 * ..
94 * .. Scalars in Common ..
95  LOGICAL LERR, OK
96  CHARACTER*32 SRNAMT
97  INTEGER INFOT, NOUT
98 * ..
99 * .. Common blocks ..
100  COMMON / infoc / infot, nout, ok, lerr
101  COMMON / srnamc / srnamt
102 * ..
103 * .. Executable Statements ..
104 *
105  nout = nunit
106  WRITE( nout, fmt = * )
107  c2 = path( 2: 3 )
108 *
109 * Set the variables to innocuous values.
110 *
111  DO 20 j = 1, nmax
112  DO 10 i = 1, nmax
113  a( i, j ) = 1.d0 / dble( i+j )
114  10 CONTINUE
115  sel( j ) = .true.
116  20 CONTINUE
117  ok = .true.
118  nt = 0
119 *
120 * Test error exits of the nonsymmetric eigenvalue routines.
121 *
122  IF( lsamen( 2, c2, 'HS' ) ) THEN
123 *
124 * ZGEBAL
125 *
126  srnamt = 'ZGEBAL'
127  infot = 1
128  CALL zgebal( '/', 0, a, 1, ilo, ihi, s, info )
129  CALL chkxer( 'ZGEBAL', infot, nout, lerr, ok )
130  infot = 2
131  CALL zgebal( 'N', -1, a, 1, ilo, ihi, s, info )
132  CALL chkxer( 'ZGEBAL', infot, nout, lerr, ok )
133  infot = 4
134  CALL zgebal( 'N', 2, a, 1, ilo, ihi, s, info )
135  CALL chkxer( 'ZGEBAL', infot, nout, lerr, ok )
136  nt = nt + 3
137 *
138 * ZGEBAK
139 *
140  srnamt = 'ZGEBAK'
141  infot = 1
142  CALL zgebak( '/', 'R', 0, 1, 0, s, 0, a, 1, info )
143  CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
144  infot = 2
145  CALL zgebak( 'N', '/', 0, 1, 0, s, 0, a, 1, info )
146  CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
147  infot = 3
148  CALL zgebak( 'N', 'R', -1, 1, 0, s, 0, a, 1, info )
149  CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
150  infot = 4
151  CALL zgebak( 'N', 'R', 0, 0, 0, s, 0, a, 1, info )
152  CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
153  infot = 4
154  CALL zgebak( 'N', 'R', 0, 2, 0, s, 0, a, 1, info )
155  CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
156  infot = 5
157  CALL zgebak( 'N', 'R', 2, 2, 1, s, 0, a, 2, info )
158  CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
159  infot = 5
160  CALL zgebak( 'N', 'R', 0, 1, 1, s, 0, a, 1, info )
161  CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
162  infot = 7
163  CALL zgebak( 'N', 'R', 0, 1, 0, s, -1, a, 1, info )
164  CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
165  infot = 9
166  CALL zgebak( 'N', 'R', 2, 1, 2, s, 0, a, 1, info )
167  CALL chkxer( 'ZGEBAK', infot, nout, lerr, ok )
168  nt = nt + 9
169 *
170 * ZGEHRD
171 *
172  srnamt = 'ZGEHRD'
173  infot = 1
174  CALL zgehrd( -1, 1, 1, a, 1, tau, w, 1, info )
175  CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
176  infot = 2
177  CALL zgehrd( 0, 0, 0, a, 1, tau, w, 1, info )
178  CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
179  infot = 2
180  CALL zgehrd( 0, 2, 0, a, 1, tau, w, 1, info )
181  CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
182  infot = 3
183  CALL zgehrd( 1, 1, 0, a, 1, tau, w, 1, info )
184  CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
185  infot = 3
186  CALL zgehrd( 0, 1, 1, a, 1, tau, w, 1, info )
187  CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
188  infot = 5
189  CALL zgehrd( 2, 1, 1, a, 1, tau, w, 2, info )
190  CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
191  infot = 8
192  CALL zgehrd( 2, 1, 2, a, 2, tau, w, 1, info )
193  CALL chkxer( 'ZGEHRD', infot, nout, lerr, ok )
194  nt = nt + 7
195 *
196 * ZUNGHR
197 *
198  srnamt = 'ZUNGHR'
199  infot = 1
200  CALL zunghr( -1, 1, 1, a, 1, tau, w, 1, info )
201  CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
202  infot = 2
203  CALL zunghr( 0, 0, 0, a, 1, tau, w, 1, info )
204  CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
205  infot = 2
206  CALL zunghr( 0, 2, 0, a, 1, tau, w, 1, info )
207  CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
208  infot = 3
209  CALL zunghr( 1, 1, 0, a, 1, tau, w, 1, info )
210  CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
211  infot = 3
212  CALL zunghr( 0, 1, 1, a, 1, tau, w, 1, info )
213  CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
214  infot = 5
215  CALL zunghr( 2, 1, 1, a, 1, tau, w, 1, info )
216  CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
217  infot = 8
218  CALL zunghr( 3, 1, 3, a, 3, tau, w, 1, info )
219  CALL chkxer( 'ZUNGHR', infot, nout, lerr, ok )
220  nt = nt + 7
221 *
222 * ZUNMHR
223 *
224  srnamt = 'ZUNMHR'
225  infot = 1
226  CALL zunmhr( '/', 'N', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
227  $ info )
228  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
229  infot = 2
230  CALL zunmhr( 'L', '/', 0, 0, 1, 0, a, 1, tau, c, 1, w, 1,
231  $ info )
232  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
233  infot = 3
234  CALL zunmhr( 'L', 'N', -1, 0, 1, 0, a, 1, tau, c, 1, w, 1,
235  $ info )
236  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
237  infot = 4
238  CALL zunmhr( 'L', 'N', 0, -1, 1, 0, a, 1, tau, c, 1, w, 1,
239  $ info )
240  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
241  infot = 5
242  CALL zunmhr( 'L', 'N', 0, 0, 0, 0, a, 1, tau, c, 1, w, 1,
243  $ info )
244  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
245  infot = 5
246  CALL zunmhr( 'L', 'N', 0, 0, 2, 0, a, 1, tau, c, 1, w, 1,
247  $ info )
248  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
249  infot = 5
250  CALL zunmhr( 'L', 'N', 1, 2, 2, 1, a, 1, tau, c, 1, w, 2,
251  $ info )
252  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
253  infot = 5
254  CALL zunmhr( 'R', 'N', 2, 1, 2, 1, a, 1, tau, c, 2, w, 2,
255  $ info )
256  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
257  infot = 6
258  CALL zunmhr( 'L', 'N', 1, 1, 1, 0, a, 1, tau, c, 1, w, 1,
259  $ info )
260  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
261  infot = 6
262  CALL zunmhr( 'L', 'N', 0, 1, 1, 1, a, 1, tau, c, 1, w, 1,
263  $ info )
264  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
265  infot = 6
266  CALL zunmhr( 'R', 'N', 1, 0, 1, 1, a, 1, tau, c, 1, w, 1,
267  $ info )
268  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
269  infot = 8
270  CALL zunmhr( 'L', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
271  $ info )
272  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
273  infot = 8
274  CALL zunmhr( 'R', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
275  $ info )
276  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
277  infot = 11
278  CALL zunmhr( 'L', 'N', 2, 1, 1, 1, a, 2, tau, c, 1, w, 1,
279  $ info )
280  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
281  infot = 13
282  CALL zunmhr( 'L', 'N', 1, 2, 1, 1, a, 1, tau, c, 1, w, 1,
283  $ info )
284  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
285  infot = 13
286  CALL zunmhr( 'R', 'N', 2, 1, 1, 1, a, 1, tau, c, 2, w, 1,
287  $ info )
288  CALL chkxer( 'ZUNMHR', infot, nout, lerr, ok )
289  nt = nt + 16
290 *
291 * ZHSEQR
292 *
293  srnamt = 'ZHSEQR'
294  infot = 1
295  CALL zhseqr( '/', 'N', 0, 1, 0, a, 1, x, c, 1, w, 1, info )
296  CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
297  infot = 2
298  CALL zhseqr( 'E', '/', 0, 1, 0, a, 1, x, c, 1, w, 1, info )
299  CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
300  infot = 3
301  CALL zhseqr( 'E', 'N', -1, 1, 0, a, 1, x, c, 1, w, 1, info )
302  CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
303  infot = 4
304  CALL zhseqr( 'E', 'N', 0, 0, 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, 2, 0, a, 1, x, c, 1, w, 1, info )
308  CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
309  infot = 5
310  CALL zhseqr( 'E', 'N', 1, 1, 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, 2, a, 1, x, c, 1, w, 1, info )
314  CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
315  infot = 7
316  CALL zhseqr( 'E', 'N', 2, 1, 2, a, 1, x, c, 2, w, 1, info )
317  CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
318  infot = 10
319  CALL zhseqr( 'E', 'V', 2, 1, 2, a, 2, x, c, 1, w, 1, info )
320  CALL chkxer( 'ZHSEQR', infot, nout, lerr, ok )
321  nt = nt + 9
322 *
323 * ZHSEIN
324 *
325  srnamt = 'ZHSEIN'
326  infot = 1
327  CALL zhsein( '/', 'N', 'N', sel, 0, a, 1, x, vl, 1, vr, 1, 0,
328  $ m, w, rw, ifaill, ifailr, info )
329  CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
330  infot = 2
331  CALL zhsein( 'R', '/', 'N', sel, 0, a, 1, x, vl, 1, vr, 1, 0,
332  $ m, w, rw, ifaill, ifailr, info )
333  CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
334  infot = 3
335  CALL zhsein( 'R', 'N', '/', sel, 0, a, 1, x, vl, 1, vr, 1, 0,
336  $ m, w, rw, ifaill, ifailr, info )
337  CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
338  infot = 5
339  CALL zhsein( 'R', 'N', 'N', sel, -1, a, 1, x, vl, 1, vr, 1, 0,
340  $ m, w, rw, ifaill, ifailr, info )
341  CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
342  infot = 7
343  CALL zhsein( 'R', 'N', 'N', sel, 2, a, 1, x, vl, 1, vr, 2, 4,
344  $ m, w, rw, ifaill, ifailr, info )
345  CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
346  infot = 10
347  CALL zhsein( 'L', 'N', 'N', sel, 2, a, 2, x, vl, 1, vr, 1, 4,
348  $ m, w, rw, ifaill, ifailr, info )
349  CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
350  infot = 12
351  CALL zhsein( 'R', 'N', 'N', sel, 2, a, 2, x, vl, 1, vr, 1, 4,
352  $ m, w, rw, ifaill, ifailr, info )
353  CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
354  infot = 13
355  CALL zhsein( 'R', 'N', 'N', sel, 2, a, 2, x, vl, 1, vr, 2, 1,
356  $ m, w, rw, ifaill, ifailr, info )
357  CALL chkxer( 'ZHSEIN', infot, nout, lerr, ok )
358  nt = nt + 8
359 *
360 * ZTREVC
361 *
362  srnamt = 'ZTREVC'
363  infot = 1
364  CALL ztrevc( '/', 'A', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w, rw,
365  $ info )
366  CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
367  infot = 2
368  CALL ztrevc( 'L', '/', sel, 0, a, 1, vl, 1, vr, 1, 0, m, w, rw,
369  $ info )
370  CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
371  infot = 4
372  CALL ztrevc( 'L', 'A', sel, -1, a, 1, vl, 1, vr, 1, 0, m, w,
373  $ rw, info )
374  CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
375  infot = 6
376  CALL ztrevc( 'L', 'A', sel, 2, a, 1, vl, 2, vr, 1, 4, m, w, rw,
377  $ info )
378  CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
379  infot = 8
380  CALL ztrevc( 'L', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w, rw,
381  $ info )
382  CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
383  infot = 10
384  CALL ztrevc( 'R', 'A', sel, 2, a, 2, vl, 1, vr, 1, 4, m, w, rw,
385  $ info )
386  CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
387  infot = 11
388  CALL ztrevc( 'L', 'A', sel, 2, a, 2, vl, 2, vr, 1, 1, m, w, rw,
389  $ info )
390  CALL chkxer( 'ZTREVC', infot, nout, lerr, ok )
391  nt = nt + 7
392  END IF
393 *
394 * Print a summary line.
395 *
396  IF( ok ) THEN
397  WRITE( nout, fmt = 9999 )path, nt
398  ELSE
399  WRITE( nout, fmt = 9998 )path
400  END IF
401 *
402  9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits',
403  $ ' (', i3, ' tests done)' )
404  9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
405  $ 'exits ***' )
406 *
407  RETURN
408 *
409 * End of ZERRHS
410 *
411  END
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
zerrhs
subroutine zerrhs(PATH, NUNIT)
ZERRHS
Definition: zerrhs.f:55
zgebal
subroutine zgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
ZGEBAL
Definition: zgebal.f:162
zgehrd
subroutine zgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZGEHRD
Definition: zgehrd.f:167
zgebak
subroutine zgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
ZGEBAK
Definition: zgebak.f:131
zunmhr
subroutine zunmhr(SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMHR
Definition: zunmhr.f:178
zhseqr
subroutine zhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
ZHSEQR
Definition: zhseqr.f:299
ztrevc
subroutine ztrevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO)
ZTREVC
Definition: ztrevc.f:218
zhsein
subroutine zhsein(SIDE, EIGSRC, INITV, SELECT, N, H, LDH, W, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, IFAILL, IFAILR, INFO)
ZHSEIN
Definition: zhsein.f:245
zunghr
subroutine zunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGHR
Definition: zunghr.f:126