LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
cerrtr.f
Go to the documentation of this file.
1 *> \brief \b CERRTR
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 CERRTR( 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 *> CERRTR tests the error exits for the COMPLEX 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 complex_lin
53 *
54 * =====================================================================
55  SUBROUTINE cerrtr( 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  REAL rcond, scale
77 * ..
78 * .. Local Arrays ..
79  REAL r1( nmax ), r2( nmax ), rw( nmax )
80  COMPLEX 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, clatbs, clatps, clatrs, ctbcon,
89  $ ctbrfs, ctbtrs, ctpcon, ctprfs, ctptri, ctptrs,
90  $ ctrcon, ctrrfs, ctrti2, ctrtri, ctrtrs
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.
107  a( 1, 2 ) = 2.
108  a( 2, 2 ) = 3.
109  a( 2, 1 ) = 4.
110  ok = .true.
111 *
112 * Test error exits for the general triangular routines.
113 *
114  IF( lsamen( 2, c2, 'TR' ) ) THEN
115 *
116 * CTRTRI
117 *
118  srnamt = 'CTRTRI'
119  infot = 1
120  CALL ctrtri( '/', 'N', 0, a, 1, info )
121  CALL chkxer( 'CTRTRI', infot, nout, lerr, ok )
122  infot = 2
123  CALL ctrtri( 'U', '/', 0, a, 1, info )
124  CALL chkxer( 'CTRTRI', infot, nout, lerr, ok )
125  infot = 3
126  CALL ctrtri( 'U', 'N', -1, a, 1, info )
127  CALL chkxer( 'CTRTRI', infot, nout, lerr, ok )
128  infot = 5
129  CALL ctrtri( 'U', 'N', 2, a, 1, info )
130  CALL chkxer( 'CTRTRI', infot, nout, lerr, ok )
131 *
132 * CTRTI2
133 *
134  srnamt = 'CTRTI2'
135  infot = 1
136  CALL ctrti2( '/', 'N', 0, a, 1, info )
137  CALL chkxer( 'CTRTI2', infot, nout, lerr, ok )
138  infot = 2
139  CALL ctrti2( 'U', '/', 0, a, 1, info )
140  CALL chkxer( 'CTRTI2', infot, nout, lerr, ok )
141  infot = 3
142  CALL ctrti2( 'U', 'N', -1, a, 1, info )
143  CALL chkxer( 'CTRTI2', infot, nout, lerr, ok )
144  infot = 5
145  CALL ctrti2( 'U', 'N', 2, a, 1, info )
146  CALL chkxer( 'CTRTI2', infot, nout, lerr, ok )
147 *
148 *
149 * CTRTRS
150 *
151  srnamt = 'CTRTRS'
152  infot = 1
153  CALL ctrtrs( '/', 'N', 'N', 0, 0, a, 1, x, 1, info )
154  CALL chkxer( 'CTRTRS', infot, nout, lerr, ok )
155  infot = 2
156  CALL ctrtrs( 'U', '/', 'N', 0, 0, a, 1, x, 1, info )
157  CALL chkxer( 'CTRTRS', infot, nout, lerr, ok )
158  infot = 3
159  CALL ctrtrs( 'U', 'N', '/', 0, 0, a, 1, x, 1, info )
160  CALL chkxer( 'CTRTRS', infot, nout, lerr, ok )
161  infot = 4
162  CALL ctrtrs( 'U', 'N', 'N', -1, 0, a, 1, x, 1, info )
163  CALL chkxer( 'CTRTRS', infot, nout, lerr, ok )
164  infot = 5
165  CALL ctrtrs( 'U', 'N', 'N', 0, -1, a, 1, x, 1, info )
166  CALL chkxer( 'CTRTRS', infot, nout, lerr, ok )
167  infot = 7
168 *
169 * CTRRFS
170 *
171  srnamt = 'CTRRFS'
172  infot = 1
173  CALL ctrrfs( '/', 'N', 'N', 0, 0, a, 1, b, 1, x, 1, r1, r2, w,
174  $ rw, info )
175  CALL chkxer( 'CTRRFS', infot, nout, lerr, ok )
176  infot = 2
177  CALL ctrrfs( 'U', '/', 'N', 0, 0, a, 1, b, 1, x, 1, r1, r2, w,
178  $ rw, info )
179  CALL chkxer( 'CTRRFS', infot, nout, lerr, ok )
180  infot = 3
181  CALL ctrrfs( 'U', 'N', '/', 0, 0, a, 1, b, 1, x, 1, r1, r2, w,
182  $ rw, info )
183  CALL chkxer( 'CTRRFS', infot, nout, lerr, ok )
184  infot = 4
185  CALL ctrrfs( 'U', 'N', 'N', -1, 0, a, 1, b, 1, x, 1, r1, r2, w,
186  $ rw, info )
187  CALL chkxer( 'CTRRFS', infot, nout, lerr, ok )
188  infot = 5
189  CALL ctrrfs( 'U', 'N', 'N', 0, -1, a, 1, b, 1, x, 1, r1, r2, w,
190  $ rw, info )
191  CALL chkxer( 'CTRRFS', infot, nout, lerr, ok )
192  infot = 7
193  CALL ctrrfs( 'U', 'N', 'N', 2, 1, a, 1, b, 2, x, 2, r1, r2, w,
194  $ rw, info )
195  CALL chkxer( 'CTRRFS', infot, nout, lerr, ok )
196  infot = 9
197  CALL ctrrfs( 'U', 'N', 'N', 2, 1, a, 2, b, 1, x, 2, r1, r2, w,
198  $ rw, info )
199  CALL chkxer( 'CTRRFS', infot, nout, lerr, ok )
200  infot = 11
201  CALL ctrrfs( 'U', 'N', 'N', 2, 1, a, 2, b, 2, x, 1, r1, r2, w,
202  $ rw, info )
203  CALL chkxer( 'CTRRFS', infot, nout, lerr, ok )
204 *
205 * CTRCON
206 *
207  srnamt = 'CTRCON'
208  infot = 1
209  CALL ctrcon( '/', 'U', 'N', 0, a, 1, rcond, w, rw, info )
210  CALL chkxer( 'CTRCON', infot, nout, lerr, ok )
211  infot = 2
212  CALL ctrcon( '1', '/', 'N', 0, a, 1, rcond, w, rw, info )
213  CALL chkxer( 'CTRCON', infot, nout, lerr, ok )
214  infot = 3
215  CALL ctrcon( '1', 'U', '/', 0, a, 1, rcond, w, rw, info )
216  CALL chkxer( 'CTRCON', infot, nout, lerr, ok )
217  infot = 4
218  CALL ctrcon( '1', 'U', 'N', -1, a, 1, rcond, w, rw, info )
219  CALL chkxer( 'CTRCON', infot, nout, lerr, ok )
220  infot = 6
221  CALL ctrcon( '1', 'U', 'N', 2, a, 1, rcond, w, rw, info )
222  CALL chkxer( 'CTRCON', infot, nout, lerr, ok )
223 *
224 * CLATRS
225 *
226  srnamt = 'CLATRS'
227  infot = 1
228  CALL clatrs( '/', 'N', 'N', 'N', 0, a, 1, x, scale, rw, info )
229  CALL chkxer( 'CLATRS', infot, nout, lerr, ok )
230  infot = 2
231  CALL clatrs( 'U', '/', 'N', 'N', 0, a, 1, x, scale, rw, info )
232  CALL chkxer( 'CLATRS', infot, nout, lerr, ok )
233  infot = 3
234  CALL clatrs( 'U', 'N', '/', 'N', 0, a, 1, x, scale, rw, info )
235  CALL chkxer( 'CLATRS', infot, nout, lerr, ok )
236  infot = 4
237  CALL clatrs( 'U', 'N', 'N', '/', 0, a, 1, x, scale, rw, info )
238  CALL chkxer( 'CLATRS', infot, nout, lerr, ok )
239  infot = 5
240  CALL clatrs( 'U', 'N', 'N', 'N', -1, a, 1, x, scale, rw, info )
241  CALL chkxer( 'CLATRS', infot, nout, lerr, ok )
242  infot = 7
243  CALL clatrs( 'U', 'N', 'N', 'N', 2, a, 1, x, scale, rw, info )
244  CALL chkxer( 'CLATRS', 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 * CTPTRI
251 *
252  srnamt = 'CTPTRI'
253  infot = 1
254  CALL ctptri( '/', 'N', 0, a, info )
255  CALL chkxer( 'CTPTRI', infot, nout, lerr, ok )
256  infot = 2
257  CALL ctptri( 'U', '/', 0, a, info )
258  CALL chkxer( 'CTPTRI', infot, nout, lerr, ok )
259  infot = 3
260  CALL ctptri( 'U', 'N', -1, a, info )
261  CALL chkxer( 'CTPTRI', infot, nout, lerr, ok )
262 *
263 * CTPTRS
264 *
265  srnamt = 'CTPTRS'
266  infot = 1
267  CALL ctptrs( '/', 'N', 'N', 0, 0, a, x, 1, info )
268  CALL chkxer( 'CTPTRS', infot, nout, lerr, ok )
269  infot = 2
270  CALL ctptrs( 'U', '/', 'N', 0, 0, a, x, 1, info )
271  CALL chkxer( 'CTPTRS', infot, nout, lerr, ok )
272  infot = 3
273  CALL ctptrs( 'U', 'N', '/', 0, 0, a, x, 1, info )
274  CALL chkxer( 'CTPTRS', infot, nout, lerr, ok )
275  infot = 4
276  CALL ctptrs( 'U', 'N', 'N', -1, 0, a, x, 1, info )
277  CALL chkxer( 'CTPTRS', infot, nout, lerr, ok )
278  infot = 5
279  CALL ctptrs( 'U', 'N', 'N', 0, -1, a, x, 1, info )
280  CALL chkxer( 'CTPTRS', infot, nout, lerr, ok )
281  infot = 8
282  CALL ctptrs( 'U', 'N', 'N', 2, 1, a, x, 1, info )
283  CALL chkxer( 'CTPTRS', infot, nout, lerr, ok )
284 *
285 * CTPRFS
286 *
287  srnamt = 'CTPRFS'
288  infot = 1
289  CALL ctprfs( '/', 'N', 'N', 0, 0, a, b, 1, x, 1, r1, r2, w, rw,
290  $ info )
291  CALL chkxer( 'CTPRFS', infot, nout, lerr, ok )
292  infot = 2
293  CALL ctprfs( 'U', '/', 'N', 0, 0, a, b, 1, x, 1, r1, r2, w, rw,
294  $ info )
295  CALL chkxer( 'CTPRFS', infot, nout, lerr, ok )
296  infot = 3
297  CALL ctprfs( 'U', 'N', '/', 0, 0, a, b, 1, x, 1, r1, r2, w, rw,
298  $ info )
299  CALL chkxer( 'CTPRFS', infot, nout, lerr, ok )
300  infot = 4
301  CALL ctprfs( 'U', 'N', 'N', -1, 0, a, b, 1, x, 1, r1, r2, w,
302  $ rw, info )
303  CALL chkxer( 'CTPRFS', infot, nout, lerr, ok )
304  infot = 5
305  CALL ctprfs( 'U', 'N', 'N', 0, -1, a, b, 1, x, 1, r1, r2, w,
306  $ rw, info )
307  CALL chkxer( 'CTPRFS', infot, nout, lerr, ok )
308  infot = 8
309  CALL ctprfs( 'U', 'N', 'N', 2, 1, a, b, 1, x, 2, r1, r2, w, rw,
310  $ info )
311  CALL chkxer( 'CTPRFS', infot, nout, lerr, ok )
312  infot = 10
313  CALL ctprfs( 'U', 'N', 'N', 2, 1, a, b, 2, x, 1, r1, r2, w, rw,
314  $ info )
315  CALL chkxer( 'CTPRFS', infot, nout, lerr, ok )
316 *
317 * CTPCON
318 *
319  srnamt = 'CTPCON'
320  infot = 1
321  CALL ctpcon( '/', 'U', 'N', 0, a, rcond, w, rw, info )
322  CALL chkxer( 'CTPCON', infot, nout, lerr, ok )
323  infot = 2
324  CALL ctpcon( '1', '/', 'N', 0, a, rcond, w, rw, info )
325  CALL chkxer( 'CTPCON', infot, nout, lerr, ok )
326  infot = 3
327  CALL ctpcon( '1', 'U', '/', 0, a, rcond, w, rw, info )
328  CALL chkxer( 'CTPCON', infot, nout, lerr, ok )
329  infot = 4
330  CALL ctpcon( '1', 'U', 'N', -1, a, rcond, w, rw, info )
331  CALL chkxer( 'CTPCON', infot, nout, lerr, ok )
332 *
333 * CLATPS
334 *
335  srnamt = 'CLATPS'
336  infot = 1
337  CALL clatps( '/', 'N', 'N', 'N', 0, a, x, scale, rw, info )
338  CALL chkxer( 'CLATPS', infot, nout, lerr, ok )
339  infot = 2
340  CALL clatps( 'U', '/', 'N', 'N', 0, a, x, scale, rw, info )
341  CALL chkxer( 'CLATPS', infot, nout, lerr, ok )
342  infot = 3
343  CALL clatps( 'U', 'N', '/', 'N', 0, a, x, scale, rw, info )
344  CALL chkxer( 'CLATPS', infot, nout, lerr, ok )
345  infot = 4
346  CALL clatps( 'U', 'N', 'N', '/', 0, a, x, scale, rw, info )
347  CALL chkxer( 'CLATPS', infot, nout, lerr, ok )
348  infot = 5
349  CALL clatps( 'U', 'N', 'N', 'N', -1, a, x, scale, rw, info )
350  CALL chkxer( 'CLATPS', 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 * CTBTRS
357 *
358  srnamt = 'CTBTRS'
359  infot = 1
360  CALL ctbtrs( '/', 'N', 'N', 0, 0, 0, a, 1, x, 1, info )
361  CALL chkxer( 'CTBTRS', infot, nout, lerr, ok )
362  infot = 2
363  CALL ctbtrs( 'U', '/', 'N', 0, 0, 0, a, 1, x, 1, info )
364  CALL chkxer( 'CTBTRS', infot, nout, lerr, ok )
365  infot = 3
366  CALL ctbtrs( 'U', 'N', '/', 0, 0, 0, a, 1, x, 1, info )
367  CALL chkxer( 'CTBTRS', infot, nout, lerr, ok )
368  infot = 4
369  CALL ctbtrs( 'U', 'N', 'N', -1, 0, 0, a, 1, x, 1, info )
370  CALL chkxer( 'CTBTRS', infot, nout, lerr, ok )
371  infot = 5
372  CALL ctbtrs( 'U', 'N', 'N', 0, -1, 0, a, 1, x, 1, info )
373  CALL chkxer( 'CTBTRS', infot, nout, lerr, ok )
374  infot = 6
375  CALL ctbtrs( 'U', 'N', 'N', 0, 0, -1, a, 1, x, 1, info )
376  CALL chkxer( 'CTBTRS', infot, nout, lerr, ok )
377  infot = 8
378  CALL ctbtrs( 'U', 'N', 'N', 2, 1, 1, a, 1, x, 2, info )
379  CALL chkxer( 'CTBTRS', infot, nout, lerr, ok )
380  infot = 10
381  CALL ctbtrs( 'U', 'N', 'N', 2, 0, 1, a, 1, x, 1, info )
382  CALL chkxer( 'CTBTRS', infot, nout, lerr, ok )
383 *
384 * CTBRFS
385 *
386  srnamt = 'CTBRFS'
387  infot = 1
388  CALL ctbrfs( '/', 'N', 'N', 0, 0, 0, a, 1, b, 1, x, 1, r1, r2,
389  $ w, rw, info )
390  CALL chkxer( 'CTBRFS', infot, nout, lerr, ok )
391  infot = 2
392  CALL ctbrfs( 'U', '/', 'N', 0, 0, 0, a, 1, b, 1, x, 1, r1, r2,
393  $ w, rw, info )
394  CALL chkxer( 'CTBRFS', infot, nout, lerr, ok )
395  infot = 3
396  CALL ctbrfs( 'U', 'N', '/', 0, 0, 0, a, 1, b, 1, x, 1, r1, r2,
397  $ w, rw, info )
398  CALL chkxer( 'CTBRFS', infot, nout, lerr, ok )
399  infot = 4
400  CALL ctbrfs( 'U', 'N', 'N', -1, 0, 0, a, 1, b, 1, x, 1, r1, r2,
401  $ w, rw, info )
402  CALL chkxer( 'CTBRFS', infot, nout, lerr, ok )
403  infot = 5
404  CALL ctbrfs( 'U', 'N', 'N', 0, -1, 0, a, 1, b, 1, x, 1, r1, r2,
405  $ w, rw, info )
406  CALL chkxer( 'CTBRFS', infot, nout, lerr, ok )
407  infot = 6
408  CALL ctbrfs( 'U', 'N', 'N', 0, 0, -1, a, 1, b, 1, x, 1, r1, r2,
409  $ w, rw, info )
410  CALL chkxer( 'CTBRFS', infot, nout, lerr, ok )
411  infot = 8
412  CALL ctbrfs( 'U', 'N', 'N', 2, 1, 1, a, 1, b, 2, x, 2, r1, r2,
413  $ w, rw, info )
414  CALL chkxer( 'CTBRFS', infot, nout, lerr, ok )
415  infot = 10
416  CALL ctbrfs( 'U', 'N', 'N', 2, 1, 1, a, 2, b, 1, x, 2, r1, r2,
417  $ w, rw, info )
418  CALL chkxer( 'CTBRFS', infot, nout, lerr, ok )
419  infot = 12
420  CALL ctbrfs( 'U', 'N', 'N', 2, 1, 1, a, 2, b, 2, x, 1, r1, r2,
421  $ w, rw, info )
422  CALL chkxer( 'CTBRFS', infot, nout, lerr, ok )
423 *
424 * CTBCON
425 *
426  srnamt = 'CTBCON'
427  infot = 1
428  CALL ctbcon( '/', 'U', 'N', 0, 0, a, 1, rcond, w, rw, info )
429  CALL chkxer( 'CTBCON', infot, nout, lerr, ok )
430  infot = 2
431  CALL ctbcon( '1', '/', 'N', 0, 0, a, 1, rcond, w, rw, info )
432  CALL chkxer( 'CTBCON', infot, nout, lerr, ok )
433  infot = 3
434  CALL ctbcon( '1', 'U', '/', 0, 0, a, 1, rcond, w, rw, info )
435  CALL chkxer( 'CTBCON', infot, nout, lerr, ok )
436  infot = 4
437  CALL ctbcon( '1', 'U', 'N', -1, 0, a, 1, rcond, w, rw, info )
438  CALL chkxer( 'CTBCON', infot, nout, lerr, ok )
439  infot = 5
440  CALL ctbcon( '1', 'U', 'N', 0, -1, a, 1, rcond, w, rw, info )
441  CALL chkxer( 'CTBCON', infot, nout, lerr, ok )
442  infot = 7
443  CALL ctbcon( '1', 'U', 'N', 2, 1, a, 1, rcond, w, rw, info )
444  CALL chkxer( 'CTBCON', infot, nout, lerr, ok )
445 *
446 * CLATBS
447 *
448  srnamt = 'CLATBS'
449  infot = 1
450  CALL clatbs( '/', 'N', 'N', 'N', 0, 0, a, 1, x, scale, rw,
451  $ info )
452  CALL chkxer( 'CLATBS', infot, nout, lerr, ok )
453  infot = 2
454  CALL clatbs( 'U', '/', 'N', 'N', 0, 0, a, 1, x, scale, rw,
455  $ info )
456  CALL chkxer( 'CLATBS', infot, nout, lerr, ok )
457  infot = 3
458  CALL clatbs( 'U', 'N', '/', 'N', 0, 0, a, 1, x, scale, rw,
459  $ info )
460  CALL chkxer( 'CLATBS', infot, nout, lerr, ok )
461  infot = 4
462  CALL clatbs( 'U', 'N', 'N', '/', 0, 0, a, 1, x, scale, rw,
463  $ info )
464  CALL chkxer( 'CLATBS', infot, nout, lerr, ok )
465  infot = 5
466  CALL clatbs( 'U', 'N', 'N', 'N', -1, 0, a, 1, x, scale, rw,
467  $ info )
468  CALL chkxer( 'CLATBS', infot, nout, lerr, ok )
469  infot = 6
470  CALL clatbs( 'U', 'N', 'N', 'N', 1, -1, a, 1, x, scale, rw,
471  $ info )
472  CALL chkxer( 'CLATBS', infot, nout, lerr, ok )
473  infot = 8
474  CALL clatbs( 'U', 'N', 'N', 'N', 2, 1, a, 1, x, scale, rw,
475  $ info )
476  CALL chkxer( 'CLATBS', 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 CERRTR
486 *
487  END