LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
zerrtr.f
Go to the documentation of this file.
1 *> \brief \b ZERRTR
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 ZERRTR( 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 *> ZERRTR tests the error exits for the COMPLEX*16 triangular routines.
25 *> \endverbatim
26 *
27 * Arguments:
28 * ==========
29 *
30 *> \param[in] PATH
31 *> \verbatim
32 *> PATH is CHARACTER*3
33 *> The LAPACK path name for the routines to be tested.
34 *> \endverbatim
35 *>
36 *> \param[in] NUNIT
37 *> \verbatim
38 *> NUNIT is INTEGER
39 *> The unit number for output.
40 *> \endverbatim
41 *
42 * Authors:
43 * ========
44 *
45 *> \author Univ. of Tennessee
46 *> \author Univ. of California Berkeley
47 *> \author Univ. of Colorado Denver
48 *> \author NAG Ltd.
49 *
50 *> \date November 2011
51 *
52 *> \ingroup complex16_lin
53 *
54 * =====================================================================
55  SUBROUTINE zerrtr( PATH, NUNIT )
56 *
57 * -- LAPACK test routine (version 3.4.0) --
58 * -- LAPACK is a software package provided by Univ. of Tennessee, --
59 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
60 * November 2011
61 *
62 * .. Scalar Arguments ..
63  CHARACTER*3 path
64  INTEGER nunit
65 * ..
66 *
67 * =====================================================================
68 *
69 * .. Parameters ..
70  INTEGER nmax
71  parameter( nmax = 2 )
72 * ..
73 * .. Local Scalars ..
74  CHARACTER*2 c2
75  INTEGER info
76  DOUBLE PRECISION rcond, scale
77 * ..
78 * .. Local Arrays ..
79  DOUBLE PRECISION r1( nmax ), r2( nmax ), rw( nmax )
80  COMPLEX*16 a( nmax, nmax ), b( nmax ), w( nmax ),
81  $ x( nmax )
82 * ..
83 * .. External Functions ..
84  LOGICAL lsamen
85  EXTERNAL lsamen
86 * ..
87 * .. External Subroutines ..
88  EXTERNAL alaesm, chkxer, zlatbs, zlatps, zlatrs, ztbcon,
89  $ ztbrfs, ztbtrs, ztpcon, ztprfs, ztptri, ztptrs,
90  $ ztrcon, ztrrfs, ztrti2, ztrtri, ztrtrs
91 * ..
92 * .. Scalars in Common ..
93  LOGICAL lerr, ok
94  CHARACTER*32 srnamt
95  INTEGER infot, nout
96 * ..
97 * .. Common blocks ..
98  common / infoc / infot, nout, ok, lerr
99  common / srnamc / srnamt
100 * ..
101 * .. Executable Statements ..
102 *
103  nout = nunit
104  WRITE( nout, fmt = * )
105  c2 = path( 2: 3 )
106  a( 1, 1 ) = 1.d0
107  a( 1, 2 ) = 2.d0
108  a( 2, 2 ) = 3.d0
109  a( 2, 1 ) = 4.d0
110  ok = .true.
111 *
112 * Test error exits for the general triangular routines.
113 *
114  IF( lsamen( 2, c2, 'TR' ) ) THEN
115 *
116 * ZTRTRI
117 *
118  srnamt = 'ZTRTRI'
119  infot = 1
120  CALL ztrtri( '/', 'N', 0, a, 1, info )
121  CALL chkxer( 'ZTRTRI', infot, nout, lerr, ok )
122  infot = 2
123  CALL ztrtri( 'U', '/', 0, a, 1, info )
124  CALL chkxer( 'ZTRTRI', infot, nout, lerr, ok )
125  infot = 3
126  CALL ztrtri( 'U', 'N', -1, a, 1, info )
127  CALL chkxer( 'ZTRTRI', infot, nout, lerr, ok )
128  infot = 5
129  CALL ztrtri( 'U', 'N', 2, a, 1, info )
130  CALL chkxer( 'ZTRTRI', infot, nout, lerr, ok )
131 *
132 * ZTRTI2
133 *
134  srnamt = 'ZTRTI2'
135  infot = 1
136  CALL ztrti2( '/', 'N', 0, a, 1, info )
137  CALL chkxer( 'ZTRTI2', infot, nout, lerr, ok )
138  infot = 2
139  CALL ztrti2( 'U', '/', 0, a, 1, info )
140  CALL chkxer( 'ZTRTI2', infot, nout, lerr, ok )
141  infot = 3
142  CALL ztrti2( 'U', 'N', -1, a, 1, info )
143  CALL chkxer( 'ZTRTI2', infot, nout, lerr, ok )
144  infot = 5
145  CALL ztrti2( 'U', 'N', 2, a, 1, info )
146  CALL chkxer( 'ZTRTI2', infot, nout, lerr, ok )
147 *
148 *
149 * ZTRTRS
150 *
151  srnamt = 'ZTRTRS'
152  infot = 1
153  CALL ztrtrs( '/', 'N', 'N', 0, 0, a, 1, x, 1, info )
154  CALL chkxer( 'ZTRTRS', infot, nout, lerr, ok )
155  infot = 2
156  CALL ztrtrs( 'U', '/', 'N', 0, 0, a, 1, x, 1, info )
157  CALL chkxer( 'ZTRTRS', infot, nout, lerr, ok )
158  infot = 3
159  CALL ztrtrs( 'U', 'N', '/', 0, 0, a, 1, x, 1, info )
160  CALL chkxer( 'ZTRTRS', infot, nout, lerr, ok )
161  infot = 4
162  CALL ztrtrs( 'U', 'N', 'N', -1, 0, a, 1, x, 1, info )
163  CALL chkxer( 'ZTRTRS', infot, nout, lerr, ok )
164  infot = 5
165  CALL ztrtrs( 'U', 'N', 'N', 0, -1, a, 1, x, 1, info )
166  CALL chkxer( 'ZTRTRS', infot, nout, lerr, ok )
167  infot = 7
168 *
169 * ZTRRFS
170 *
171  srnamt = 'ZTRRFS'
172  infot = 1
173  CALL ztrrfs( '/', 'N', 'N', 0, 0, a, 1, b, 1, x, 1, r1, r2, w,
174  $ rw, info )
175  CALL chkxer( 'ZTRRFS', infot, nout, lerr, ok )
176  infot = 2
177  CALL ztrrfs( 'U', '/', 'N', 0, 0, a, 1, b, 1, x, 1, r1, r2, w,
178  $ rw, info )
179  CALL chkxer( 'ZTRRFS', infot, nout, lerr, ok )
180  infot = 3
181  CALL ztrrfs( 'U', 'N', '/', 0, 0, a, 1, b, 1, x, 1, r1, r2, w,
182  $ rw, info )
183  CALL chkxer( 'ZTRRFS', infot, nout, lerr, ok )
184  infot = 4
185  CALL ztrrfs( 'U', 'N', 'N', -1, 0, a, 1, b, 1, x, 1, r1, r2, w,
186  $ rw, info )
187  CALL chkxer( 'ZTRRFS', infot, nout, lerr, ok )
188  infot = 5
189  CALL ztrrfs( 'U', 'N', 'N', 0, -1, a, 1, b, 1, x, 1, r1, r2, w,
190  $ rw, info )
191  CALL chkxer( 'ZTRRFS', infot, nout, lerr, ok )
192  infot = 7
193  CALL ztrrfs( 'U', 'N', 'N', 2, 1, a, 1, b, 2, x, 2, r1, r2, w,
194  $ rw, info )
195  CALL chkxer( 'ZTRRFS', infot, nout, lerr, ok )
196  infot = 9
197  CALL ztrrfs( 'U', 'N', 'N', 2, 1, a, 2, b, 1, x, 2, r1, r2, w,
198  $ rw, info )
199  CALL chkxer( 'ZTRRFS', infot, nout, lerr, ok )
200  infot = 11
201  CALL ztrrfs( 'U', 'N', 'N', 2, 1, a, 2, b, 2, x, 1, r1, r2, w,
202  $ rw, info )
203  CALL chkxer( 'ZTRRFS', infot, nout, lerr, ok )
204 *
205 * ZTRCON
206 *
207  srnamt = 'ZTRCON'
208  infot = 1
209  CALL ztrcon( '/', 'U', 'N', 0, a, 1, rcond, w, rw, info )
210  CALL chkxer( 'ZTRCON', infot, nout, lerr, ok )
211  infot = 2
212  CALL ztrcon( '1', '/', 'N', 0, a, 1, rcond, w, rw, info )
213  CALL chkxer( 'ZTRCON', infot, nout, lerr, ok )
214  infot = 3
215  CALL ztrcon( '1', 'U', '/', 0, a, 1, rcond, w, rw, info )
216  CALL chkxer( 'ZTRCON', infot, nout, lerr, ok )
217  infot = 4
218  CALL ztrcon( '1', 'U', 'N', -1, a, 1, rcond, w, rw, info )
219  CALL chkxer( 'ZTRCON', infot, nout, lerr, ok )
220  infot = 6
221  CALL ztrcon( '1', 'U', 'N', 2, a, 1, rcond, w, rw, info )
222  CALL chkxer( 'ZTRCON', infot, nout, lerr, ok )
223 *
224 * ZLATRS
225 *
226  srnamt = 'ZLATRS'
227  infot = 1
228  CALL zlatrs( '/', 'N', 'N', 'N', 0, a, 1, x, scale, rw, info )
229  CALL chkxer( 'ZLATRS', infot, nout, lerr, ok )
230  infot = 2
231  CALL zlatrs( 'U', '/', 'N', 'N', 0, a, 1, x, scale, rw, info )
232  CALL chkxer( 'ZLATRS', infot, nout, lerr, ok )
233  infot = 3
234  CALL zlatrs( 'U', 'N', '/', 'N', 0, a, 1, x, scale, rw, info )
235  CALL chkxer( 'ZLATRS', infot, nout, lerr, ok )
236  infot = 4
237  CALL zlatrs( 'U', 'N', 'N', '/', 0, a, 1, x, scale, rw, info )
238  CALL chkxer( 'ZLATRS', infot, nout, lerr, ok )
239  infot = 5
240  CALL zlatrs( 'U', 'N', 'N', 'N', -1, a, 1, x, scale, rw, info )
241  CALL chkxer( 'ZLATRS', infot, nout, lerr, ok )
242  infot = 7
243  CALL zlatrs( 'U', 'N', 'N', 'N', 2, a, 1, x, scale, rw, info )
244  CALL chkxer( 'ZLATRS', infot, nout, lerr, ok )
245 *
246 * Test error exits for the packed triangular routines.
247 *
248  ELSE IF( lsamen( 2, c2, 'TP' ) ) THEN
249 *
250 * ZTPTRI
251 *
252  srnamt = 'ZTPTRI'
253  infot = 1
254  CALL ztptri( '/', 'N', 0, a, info )
255  CALL chkxer( 'ZTPTRI', infot, nout, lerr, ok )
256  infot = 2
257  CALL ztptri( 'U', '/', 0, a, info )
258  CALL chkxer( 'ZTPTRI', infot, nout, lerr, ok )
259  infot = 3
260  CALL ztptri( 'U', 'N', -1, a, info )
261  CALL chkxer( 'ZTPTRI', infot, nout, lerr, ok )
262 *
263 * ZTPTRS
264 *
265  srnamt = 'ZTPTRS'
266  infot = 1
267  CALL ztptrs( '/', 'N', 'N', 0, 0, a, x, 1, info )
268  CALL chkxer( 'ZTPTRS', infot, nout, lerr, ok )
269  infot = 2
270  CALL ztptrs( 'U', '/', 'N', 0, 0, a, x, 1, info )
271  CALL chkxer( 'ZTPTRS', infot, nout, lerr, ok )
272  infot = 3
273  CALL ztptrs( 'U', 'N', '/', 0, 0, a, x, 1, info )
274  CALL chkxer( 'ZTPTRS', infot, nout, lerr, ok )
275  infot = 4
276  CALL ztptrs( 'U', 'N', 'N', -1, 0, a, x, 1, info )
277  CALL chkxer( 'ZTPTRS', infot, nout, lerr, ok )
278  infot = 5
279  CALL ztptrs( 'U', 'N', 'N', 0, -1, a, x, 1, info )
280  CALL chkxer( 'ZTPTRS', infot, nout, lerr, ok )
281  infot = 8
282  CALL ztptrs( 'U', 'N', 'N', 2, 1, a, x, 1, info )
283  CALL chkxer( 'ZTPTRS', infot, nout, lerr, ok )
284 *
285 * ZTPRFS
286 *
287  srnamt = 'ZTPRFS'
288  infot = 1
289  CALL ztprfs( '/', 'N', 'N', 0, 0, a, b, 1, x, 1, r1, r2, w, rw,
290  $ info )
291  CALL chkxer( 'ZTPRFS', infot, nout, lerr, ok )
292  infot = 2
293  CALL ztprfs( 'U', '/', 'N', 0, 0, a, b, 1, x, 1, r1, r2, w, rw,
294  $ info )
295  CALL chkxer( 'ZTPRFS', infot, nout, lerr, ok )
296  infot = 3
297  CALL ztprfs( 'U', 'N', '/', 0, 0, a, b, 1, x, 1, r1, r2, w, rw,
298  $ info )
299  CALL chkxer( 'ZTPRFS', infot, nout, lerr, ok )
300  infot = 4
301  CALL ztprfs( 'U', 'N', 'N', -1, 0, a, b, 1, x, 1, r1, r2, w,
302  $ rw, info )
303  CALL chkxer( 'ZTPRFS', infot, nout, lerr, ok )
304  infot = 5
305  CALL ztprfs( 'U', 'N', 'N', 0, -1, a, b, 1, x, 1, r1, r2, w,
306  $ rw, info )
307  CALL chkxer( 'ZTPRFS', infot, nout, lerr, ok )
308  infot = 8
309  CALL ztprfs( 'U', 'N', 'N', 2, 1, a, b, 1, x, 2, r1, r2, w, rw,
310  $ info )
311  CALL chkxer( 'ZTPRFS', infot, nout, lerr, ok )
312  infot = 10
313  CALL ztprfs( 'U', 'N', 'N', 2, 1, a, b, 2, x, 1, r1, r2, w, rw,
314  $ info )
315  CALL chkxer( 'ZTPRFS', infot, nout, lerr, ok )
316 *
317 * ZTPCON
318 *
319  srnamt = 'ZTPCON'
320  infot = 1
321  CALL ztpcon( '/', 'U', 'N', 0, a, rcond, w, rw, info )
322  CALL chkxer( 'ZTPCON', infot, nout, lerr, ok )
323  infot = 2
324  CALL ztpcon( '1', '/', 'N', 0, a, rcond, w, rw, info )
325  CALL chkxer( 'ZTPCON', infot, nout, lerr, ok )
326  infot = 3
327  CALL ztpcon( '1', 'U', '/', 0, a, rcond, w, rw, info )
328  CALL chkxer( 'ZTPCON', infot, nout, lerr, ok )
329  infot = 4
330  CALL ztpcon( '1', 'U', 'N', -1, a, rcond, w, rw, info )
331  CALL chkxer( 'ZTPCON', infot, nout, lerr, ok )
332 *
333 * ZLATPS
334 *
335  srnamt = 'ZLATPS'
336  infot = 1
337  CALL zlatps( '/', 'N', 'N', 'N', 0, a, x, scale, rw, info )
338  CALL chkxer( 'ZLATPS', infot, nout, lerr, ok )
339  infot = 2
340  CALL zlatps( 'U', '/', 'N', 'N', 0, a, x, scale, rw, info )
341  CALL chkxer( 'ZLATPS', infot, nout, lerr, ok )
342  infot = 3
343  CALL zlatps( 'U', 'N', '/', 'N', 0, a, x, scale, rw, info )
344  CALL chkxer( 'ZLATPS', infot, nout, lerr, ok )
345  infot = 4
346  CALL zlatps( 'U', 'N', 'N', '/', 0, a, x, scale, rw, info )
347  CALL chkxer( 'ZLATPS', infot, nout, lerr, ok )
348  infot = 5
349  CALL zlatps( 'U', 'N', 'N', 'N', -1, a, x, scale, rw, info )
350  CALL chkxer( 'ZLATPS', infot, nout, lerr, ok )
351 *
352 * Test error exits for the banded triangular routines.
353 *
354  ELSE IF( lsamen( 2, c2, 'TB' ) ) THEN
355 *
356 * ZTBTRS
357 *
358  srnamt = 'ZTBTRS'
359  infot = 1
360  CALL ztbtrs( '/', 'N', 'N', 0, 0, 0, a, 1, x, 1, info )
361  CALL chkxer( 'ZTBTRS', infot, nout, lerr, ok )
362  infot = 2
363  CALL ztbtrs( 'U', '/', 'N', 0, 0, 0, a, 1, x, 1, info )
364  CALL chkxer( 'ZTBTRS', infot, nout, lerr, ok )
365  infot = 3
366  CALL ztbtrs( 'U', 'N', '/', 0, 0, 0, a, 1, x, 1, info )
367  CALL chkxer( 'ZTBTRS', infot, nout, lerr, ok )
368  infot = 4
369  CALL ztbtrs( 'U', 'N', 'N', -1, 0, 0, a, 1, x, 1, info )
370  CALL chkxer( 'ZTBTRS', infot, nout, lerr, ok )
371  infot = 5
372  CALL ztbtrs( 'U', 'N', 'N', 0, -1, 0, a, 1, x, 1, info )
373  CALL chkxer( 'ZTBTRS', infot, nout, lerr, ok )
374  infot = 6
375  CALL ztbtrs( 'U', 'N', 'N', 0, 0, -1, a, 1, x, 1, info )
376  CALL chkxer( 'ZTBTRS', infot, nout, lerr, ok )
377  infot = 8
378  CALL ztbtrs( 'U', 'N', 'N', 2, 1, 1, a, 1, x, 2, info )
379  CALL chkxer( 'ZTBTRS', infot, nout, lerr, ok )
380  infot = 10
381  CALL ztbtrs( 'U', 'N', 'N', 2, 0, 1, a, 1, x, 1, info )
382  CALL chkxer( 'ZTBTRS', infot, nout, lerr, ok )
383 *
384 * ZTBRFS
385 *
386  srnamt = 'ZTBRFS'
387  infot = 1
388  CALL ztbrfs( '/', 'N', 'N', 0, 0, 0, a, 1, b, 1, x, 1, r1, r2,
389  $ w, rw, info )
390  CALL chkxer( 'ZTBRFS', infot, nout, lerr, ok )
391  infot = 2
392  CALL ztbrfs( 'U', '/', 'N', 0, 0, 0, a, 1, b, 1, x, 1, r1, r2,
393  $ w, rw, info )
394  CALL chkxer( 'ZTBRFS', infot, nout, lerr, ok )
395  infot = 3
396  CALL ztbrfs( 'U', 'N', '/', 0, 0, 0, a, 1, b, 1, x, 1, r1, r2,
397  $ w, rw, info )
398  CALL chkxer( 'ZTBRFS', infot, nout, lerr, ok )
399  infot = 4
400  CALL ztbrfs( 'U', 'N', 'N', -1, 0, 0, a, 1, b, 1, x, 1, r1, r2,
401  $ w, rw, info )
402  CALL chkxer( 'ZTBRFS', infot, nout, lerr, ok )
403  infot = 5
404  CALL ztbrfs( 'U', 'N', 'N', 0, -1, 0, a, 1, b, 1, x, 1, r1, r2,
405  $ w, rw, info )
406  CALL chkxer( 'ZTBRFS', infot, nout, lerr, ok )
407  infot = 6
408  CALL ztbrfs( 'U', 'N', 'N', 0, 0, -1, a, 1, b, 1, x, 1, r1, r2,
409  $ w, rw, info )
410  CALL chkxer( 'ZTBRFS', infot, nout, lerr, ok )
411  infot = 8
412  CALL ztbrfs( 'U', 'N', 'N', 2, 1, 1, a, 1, b, 2, x, 2, r1, r2,
413  $ w, rw, info )
414  CALL chkxer( 'ZTBRFS', infot, nout, lerr, ok )
415  infot = 10
416  CALL ztbrfs( 'U', 'N', 'N', 2, 1, 1, a, 2, b, 1, x, 2, r1, r2,
417  $ w, rw, info )
418  CALL chkxer( 'ZTBRFS', infot, nout, lerr, ok )
419  infot = 12
420  CALL ztbrfs( 'U', 'N', 'N', 2, 1, 1, a, 2, b, 2, x, 1, r1, r2,
421  $ w, rw, info )
422  CALL chkxer( 'ZTBRFS', infot, nout, lerr, ok )
423 *
424 * ZTBCON
425 *
426  srnamt = 'ZTBCON'
427  infot = 1
428  CALL ztbcon( '/', 'U', 'N', 0, 0, a, 1, rcond, w, rw, info )
429  CALL chkxer( 'ZTBCON', infot, nout, lerr, ok )
430  infot = 2
431  CALL ztbcon( '1', '/', 'N', 0, 0, a, 1, rcond, w, rw, info )
432  CALL chkxer( 'ZTBCON', infot, nout, lerr, ok )
433  infot = 3
434  CALL ztbcon( '1', 'U', '/', 0, 0, a, 1, rcond, w, rw, info )
435  CALL chkxer( 'ZTBCON', infot, nout, lerr, ok )
436  infot = 4
437  CALL ztbcon( '1', 'U', 'N', -1, 0, a, 1, rcond, w, rw, info )
438  CALL chkxer( 'ZTBCON', infot, nout, lerr, ok )
439  infot = 5
440  CALL ztbcon( '1', 'U', 'N', 0, -1, a, 1, rcond, w, rw, info )
441  CALL chkxer( 'ZTBCON', infot, nout, lerr, ok )
442  infot = 7
443  CALL ztbcon( '1', 'U', 'N', 2, 1, a, 1, rcond, w, rw, info )
444  CALL chkxer( 'ZTBCON', infot, nout, lerr, ok )
445 *
446 * ZLATBS
447 *
448  srnamt = 'ZLATBS'
449  infot = 1
450  CALL zlatbs( '/', 'N', 'N', 'N', 0, 0, a, 1, x, scale, rw,
451  $ info )
452  CALL chkxer( 'ZLATBS', infot, nout, lerr, ok )
453  infot = 2
454  CALL zlatbs( 'U', '/', 'N', 'N', 0, 0, a, 1, x, scale, rw,
455  $ info )
456  CALL chkxer( 'ZLATBS', infot, nout, lerr, ok )
457  infot = 3
458  CALL zlatbs( 'U', 'N', '/', 'N', 0, 0, a, 1, x, scale, rw,
459  $ info )
460  CALL chkxer( 'ZLATBS', infot, nout, lerr, ok )
461  infot = 4
462  CALL zlatbs( 'U', 'N', 'N', '/', 0, 0, a, 1, x, scale, rw,
463  $ info )
464  CALL chkxer( 'ZLATBS', infot, nout, lerr, ok )
465  infot = 5
466  CALL zlatbs( 'U', 'N', 'N', 'N', -1, 0, a, 1, x, scale, rw,
467  $ info )
468  CALL chkxer( 'ZLATBS', infot, nout, lerr, ok )
469  infot = 6
470  CALL zlatbs( 'U', 'N', 'N', 'N', 1, -1, a, 1, x, scale, rw,
471  $ info )
472  CALL chkxer( 'ZLATBS', infot, nout, lerr, ok )
473  infot = 8
474  CALL zlatbs( 'U', 'N', 'N', 'N', 2, 1, a, 1, x, scale, rw,
475  $ info )
476  CALL chkxer( 'ZLATBS', infot, nout, lerr, ok )
477  END IF
478 *
479 * Print a summary line.
480 *
481  CALL alaesm( path, ok, nout )
482 *
483  return
484 *
485 * End of ZERRTR
486 *
487  END