LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine zerrhs ( character*3  PATH,
integer  NUNIT 
)

ZERRHS

Purpose:
 ZERRHS tests the error exits for ZGEBAK, CGEBAL, CGEHRD, ZUNGHR,
 ZUNMHR, ZHSEQR, CHSEIN, and ZTREVC.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 57 of file zerrhs.f.

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 *
subroutine zgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
ZGEBAK
Definition: zgebak.f:133
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
subroutine zgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZGEHRD
Definition: zgehrd.f:169
subroutine zunmhr(SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMHR
Definition: zunmhr.f:180
subroutine ztrevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO)
ZTREVC
Definition: ztrevc.f:220
subroutine zunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGHR
Definition: zunghr.f:128
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
subroutine zgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
ZGEBAL
Definition: zgebal.f:162
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:247
subroutine zhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
ZHSEQR
Definition: zhseqr.f:301

Here is the call graph for this function:

Here is the caller graph for this function: