1       SUBROUTINE CERRTR( PATH, NUNIT )
  2 *
  3 *  -- LAPACK test routine (version 3.1) --
  4 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  5 *     November 2006
  6 *
  7 *     .. Scalar Arguments ..
  8       CHARACTER*3        PATH
  9       INTEGER            NUNIT
 10 *     ..
 11 *
 12 *  Purpose
 13 *  =======
 14 *
 15 *  CERRTR tests the error exits for the COMPLEX triangular routines.
 16 *
 17 *  Arguments
 18 *  =========
 19 *
 20 *  PATH    (input) CHARACTER*3
 21 *          The LAPACK path name for the routines to be tested.
 22 *
 23 *  NUNIT   (input) INTEGER
 24 *          The unit number for output.
 25 *
 26 *  =====================================================================
 27 *
 28 *     .. Parameters ..
 29       INTEGER            NMAX
 30       PARAMETER          ( NMAX = 2 )
 31 *     ..
 32 *     .. Local Scalars ..
 33       CHARACTER*2        C2
 34       INTEGER            INFO
 35       REAL               RCOND, SCALE
 36 *     ..
 37 *     .. Local Arrays ..
 38       REAL               R1( NMAX ), R2( NMAX ), RW( NMAX )
 39       COMPLEX            A( NMAX, NMAX ), B( NMAX ), W( NMAX ),
 40      $                   X( NMAX )
 41 *     ..
 42 *     .. External Functions ..
 43       LOGICAL            LSAMEN
 44       EXTERNAL           LSAMEN
 45 *     ..
 46 *     .. External Subroutines ..
 47       EXTERNAL           ALAESM, CHKXER, CLATBS, CLATPS, CLATRS, CTBCON,
 48      $                   CTBRFS, CTBTRS, CTPCON, CTPRFS, CTPTRI, CTPTRS,
 49      $                   CTRCON, CTRRFS, CTRTI2, CTRTRI, CTRTRS
 50 *     ..
 51 *     .. Scalars in Common ..
 52       LOGICAL            LERR, OK
 53       CHARACTER*32       SRNAMT
 54       INTEGER            INFOT, NOUT
 55 *     ..
 56 *     .. Common blocks ..
 57       COMMON             / INFOC / INFOT, NOUT, OK, LERR
 58       COMMON             / SRNAMC / SRNAMT
 59 *     ..
 60 *     .. Executable Statements ..
 61 *
 62       NOUT = NUNIT
 63       WRITE( NOUT, FMT = * )
 64       C2 = PATH( 23 )
 65       A( 11 ) = 1.
 66       A( 12 ) = 2.
 67       A( 22 ) = 3.
 68       A( 21 ) = 4.
 69       OK = .TRUE.
 70 *
 71 *     Test error exits for the general triangular routines.
 72 *
 73       IF( LSAMEN( 2, C2, 'TR' ) ) THEN
 74 *
 75 *        CTRTRI
 76 *
 77          SRNAMT = 'CTRTRI'
 78          INFOT = 1
 79          CALL CTRTRI( '/''N'0, A, 1, INFO )
 80          CALL CHKXER( 'CTRTRI', INFOT, NOUT, LERR, OK )
 81          INFOT = 2
 82          CALL CTRTRI( 'U''/'0, A, 1, INFO )
 83          CALL CHKXER( 'CTRTRI', INFOT, NOUT, LERR, OK )
 84          INFOT = 3
 85          CALL CTRTRI( 'U''N'-1, A, 1, INFO )
 86          CALL CHKXER( 'CTRTRI', INFOT, NOUT, LERR, OK )
 87          INFOT = 5
 88          CALL CTRTRI( 'U''N'2, A, 1, INFO )
 89          CALL CHKXER( 'CTRTRI', INFOT, NOUT, LERR, OK )
 90 *
 91 *        CTRTI2
 92 *
 93          SRNAMT = 'CTRTI2'
 94          INFOT = 1
 95          CALL CTRTI2( '/''N'0, A, 1, INFO )
 96          CALL CHKXER( 'CTRTI2', INFOT, NOUT, LERR, OK )
 97          INFOT = 2
 98          CALL CTRTI2( 'U''/'0, A, 1, INFO )
 99          CALL CHKXER( 'CTRTI2', INFOT, NOUT, LERR, OK )
100          INFOT = 3
101          CALL CTRTI2( 'U''N'-1, A, 1, INFO )
102          CALL CHKXER( 'CTRTI2', INFOT, NOUT, LERR, OK )
103          INFOT = 5
104          CALL CTRTI2( 'U''N'2, A, 1, INFO )
105          CALL CHKXER( 'CTRTI2', INFOT, NOUT, LERR, OK )
106 *
107 *
108 *        CTRTRS
109 *
110          SRNAMT = 'CTRTRS'
111          INFOT = 1
112          CALL CTRTRS( '/''N''N'00, A, 1, X, 1, INFO )
113          CALL CHKXER( 'CTRTRS', INFOT, NOUT, LERR, OK )
114          INFOT = 2
115          CALL CTRTRS( 'U''/''N'00, A, 1, X, 1, INFO )
116          CALL CHKXER( 'CTRTRS', INFOT, NOUT, LERR, OK )
117          INFOT = 3
118          CALL CTRTRS( 'U''N''/'00, A, 1, X, 1, INFO )
119          CALL CHKXER( 'CTRTRS', INFOT, NOUT, LERR, OK )
120          INFOT = 4
121          CALL CTRTRS( 'U''N''N'-10, A, 1, X, 1, INFO )
122          CALL CHKXER( 'CTRTRS', INFOT, NOUT, LERR, OK )
123          INFOT = 5
124          CALL CTRTRS( 'U''N''N'0-1, A, 1, X, 1, INFO )
125          CALL CHKXER( 'CTRTRS', INFOT, NOUT, LERR, OK )
126          INFOT = 7
127 *
128 *        CTRRFS
129 *
130          SRNAMT = 'CTRRFS'
131          INFOT = 1
132          CALL CTRRFS( '/''N''N'00, A, 1, B, 1, X, 1, R1, R2, W,
133      $                RW, INFO )
134          CALL CHKXER( 'CTRRFS', INFOT, NOUT, LERR, OK )
135          INFOT = 2
136          CALL CTRRFS( 'U''/''N'00, A, 1, B, 1, X, 1, R1, R2, W,
137      $                RW, INFO )
138          CALL CHKXER( 'CTRRFS', INFOT, NOUT, LERR, OK )
139          INFOT = 3
140          CALL CTRRFS( 'U''N''/'00, A, 1, B, 1, X, 1, R1, R2, W,
141      $                RW, INFO )
142          CALL CHKXER( 'CTRRFS', INFOT, NOUT, LERR, OK )
143          INFOT = 4
144          CALL CTRRFS( 'U''N''N'-10, A, 1, B, 1, X, 1, R1, R2, W,
145      $                RW, INFO )
146          CALL CHKXER( 'CTRRFS', INFOT, NOUT, LERR, OK )
147          INFOT = 5
148          CALL CTRRFS( 'U''N''N'0-1, A, 1, B, 1, X, 1, R1, R2, W,
149      $                RW, INFO )
150          CALL CHKXER( 'CTRRFS', INFOT, NOUT, LERR, OK )
151          INFOT = 7
152          CALL CTRRFS( 'U''N''N'21, A, 1, B, 2, X, 2, R1, R2, W,
153      $                RW, INFO )
154          CALL CHKXER( 'CTRRFS', INFOT, NOUT, LERR, OK )
155          INFOT = 9
156          CALL CTRRFS( 'U''N''N'21, A, 2, B, 1, X, 2, R1, R2, W,
157      $                RW, INFO )
158          CALL CHKXER( 'CTRRFS', INFOT, NOUT, LERR, OK )
159          INFOT = 11
160          CALL CTRRFS( 'U''N''N'21, A, 2, B, 2, X, 1, R1, R2, W,
161      $                RW, INFO )
162          CALL CHKXER( 'CTRRFS', INFOT, NOUT, LERR, OK )
163 *
164 *        CTRCON
165 *
166          SRNAMT = 'CTRCON'
167          INFOT = 1
168          CALL CTRCON( '/''U''N'0, A, 1, RCOND, W, RW, INFO )
169          CALL CHKXER( 'CTRCON', INFOT, NOUT, LERR, OK )
170          INFOT = 2
171          CALL CTRCON( '1''/''N'0, A, 1, RCOND, W, RW, INFO )
172          CALL CHKXER( 'CTRCON', INFOT, NOUT, LERR, OK )
173          INFOT = 3
174          CALL CTRCON( '1''U''/'0, A, 1, RCOND, W, RW, INFO )
175          CALL CHKXER( 'CTRCON', INFOT, NOUT, LERR, OK )
176          INFOT = 4
177          CALL CTRCON( '1''U''N'-1, A, 1, RCOND, W, RW, INFO )
178          CALL CHKXER( 'CTRCON', INFOT, NOUT, LERR, OK )
179          INFOT = 6
180          CALL CTRCON( '1''U''N'2, A, 1, RCOND, W, RW, INFO )
181          CALL CHKXER( 'CTRCON', INFOT, NOUT, LERR, OK )
182 *
183 *        CLATRS
184 *
185          SRNAMT = 'CLATRS'
186          INFOT = 1
187          CALL CLATRS( '/''N''N''N'0, A, 1, X, SCALE, RW, INFO )
188          CALL CHKXER( 'CLATRS', INFOT, NOUT, LERR, OK )
189          INFOT = 2
190          CALL CLATRS( 'U''/''N''N'0, A, 1, X, SCALE, RW, INFO )
191          CALL CHKXER( 'CLATRS', INFOT, NOUT, LERR, OK )
192          INFOT = 3
193          CALL CLATRS( 'U''N''/''N'0, A, 1, X, SCALE, RW, INFO )
194          CALL CHKXER( 'CLATRS', INFOT, NOUT, LERR, OK )
195          INFOT = 4
196          CALL CLATRS( 'U''N''N''/'0, A, 1, X, SCALE, RW, INFO )
197          CALL CHKXER( 'CLATRS', INFOT, NOUT, LERR, OK )
198          INFOT = 5
199          CALL CLATRS( 'U''N''N''N'-1, A, 1, X, SCALE, RW, INFO )
200          CALL CHKXER( 'CLATRS', INFOT, NOUT, LERR, OK )
201          INFOT = 7
202          CALL CLATRS( 'U''N''N''N'2, A, 1, X, SCALE, RW, INFO )
203          CALL CHKXER( 'CLATRS', INFOT, NOUT, LERR, OK )
204 *
205 *     Test error exits for the packed triangular routines.
206 *
207       ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN
208 *
209 *        CTPTRI
210 *
211          SRNAMT = 'CTPTRI'
212          INFOT = 1
213          CALL CTPTRI( '/''N'0, A, INFO )
214          CALL CHKXER( 'CTPTRI', INFOT, NOUT, LERR, OK )
215          INFOT = 2
216          CALL CTPTRI( 'U''/'0, A, INFO )
217          CALL CHKXER( 'CTPTRI', INFOT, NOUT, LERR, OK )
218          INFOT = 3
219          CALL CTPTRI( 'U''N'-1, A, INFO )
220          CALL CHKXER( 'CTPTRI', INFOT, NOUT, LERR, OK )
221 *
222 *        CTPTRS
223 *
224          SRNAMT = 'CTPTRS'
225          INFOT = 1
226          CALL CTPTRS( '/''N''N'00, A, X, 1, INFO )
227          CALL CHKXER( 'CTPTRS', INFOT, NOUT, LERR, OK )
228          INFOT = 2
229          CALL CTPTRS( 'U''/''N'00, A, X, 1, INFO )
230          CALL CHKXER( 'CTPTRS', INFOT, NOUT, LERR, OK )
231          INFOT = 3
232          CALL CTPTRS( 'U''N''/'00, A, X, 1, INFO )
233          CALL CHKXER( 'CTPTRS', INFOT, NOUT, LERR, OK )
234          INFOT = 4
235          CALL CTPTRS( 'U''N''N'-10, A, X, 1, INFO )
236          CALL CHKXER( 'CTPTRS', INFOT, NOUT, LERR, OK )
237          INFOT = 5
238          CALL CTPTRS( 'U''N''N'0-1, A, X, 1, INFO )
239          CALL CHKXER( 'CTPTRS', INFOT, NOUT, LERR, OK )
240          INFOT = 8
241          CALL CTPTRS( 'U''N''N'21, A, X, 1, INFO )
242          CALL CHKXER( 'CTPTRS', INFOT, NOUT, LERR, OK )
243 *
244 *        CTPRFS
245 *
246          SRNAMT = 'CTPRFS'
247          INFOT = 1
248          CALL CTPRFS( '/''N''N'00, A, B, 1, X, 1, R1, R2, W, RW,
249      $                INFO )
250          CALL CHKXER( 'CTPRFS', INFOT, NOUT, LERR, OK )
251          INFOT = 2
252          CALL CTPRFS( 'U''/''N'00, A, B, 1, X, 1, R1, R2, W, RW,
253      $                INFO )
254          CALL CHKXER( 'CTPRFS', INFOT, NOUT, LERR, OK )
255          INFOT = 3
256          CALL CTPRFS( 'U''N''/'00, A, B, 1, X, 1, R1, R2, W, RW,
257      $                INFO )
258          CALL CHKXER( 'CTPRFS', INFOT, NOUT, LERR, OK )
259          INFOT = 4
260          CALL CTPRFS( 'U''N''N'-10, A, B, 1, X, 1, R1, R2, W,
261      $                RW, INFO )
262          CALL CHKXER( 'CTPRFS', INFOT, NOUT, LERR, OK )
263          INFOT = 5
264          CALL CTPRFS( 'U''N''N'0-1, A, B, 1, X, 1, R1, R2, W,
265      $                RW, INFO )
266          CALL CHKXER( 'CTPRFS', INFOT, NOUT, LERR, OK )
267          INFOT = 8
268          CALL CTPRFS( 'U''N''N'21, A, B, 1, X, 2, R1, R2, W, RW,
269      $                INFO )
270          CALL CHKXER( 'CTPRFS', INFOT, NOUT, LERR, OK )
271          INFOT = 10
272          CALL CTPRFS( 'U''N''N'21, A, B, 2, X, 1, R1, R2, W, RW,
273      $                INFO )
274          CALL CHKXER( 'CTPRFS', INFOT, NOUT, LERR, OK )
275 *
276 *        CTPCON
277 *
278          SRNAMT = 'CTPCON'
279          INFOT = 1
280          CALL CTPCON( '/''U''N'0, A, RCOND, W, RW, INFO )
281          CALL CHKXER( 'CTPCON', INFOT, NOUT, LERR, OK )
282          INFOT = 2
283          CALL CTPCON( '1''/''N'0, A, RCOND, W, RW, INFO )
284          CALL CHKXER( 'CTPCON', INFOT, NOUT, LERR, OK )
285          INFOT = 3
286          CALL CTPCON( '1''U''/'0, A, RCOND, W, RW, INFO )
287          CALL CHKXER( 'CTPCON', INFOT, NOUT, LERR, OK )
288          INFOT = 4
289          CALL CTPCON( '1''U''N'-1, A, RCOND, W, RW, INFO )
290          CALL CHKXER( 'CTPCON', INFOT, NOUT, LERR, OK )
291 *
292 *        CLATPS
293 *
294          SRNAMT = 'CLATPS'
295          INFOT = 1
296          CALL CLATPS( '/''N''N''N'0, A, X, SCALE, RW, INFO )
297          CALL CHKXER( 'CLATPS', INFOT, NOUT, LERR, OK )
298          INFOT = 2
299          CALL CLATPS( 'U''/''N''N'0, A, X, SCALE, RW, INFO )
300          CALL CHKXER( 'CLATPS', INFOT, NOUT, LERR, OK )
301          INFOT = 3
302          CALL CLATPS( 'U''N''/''N'0, A, X, SCALE, RW, INFO )
303          CALL CHKXER( 'CLATPS', INFOT, NOUT, LERR, OK )
304          INFOT = 4
305          CALL CLATPS( 'U''N''N''/'0, A, X, SCALE, RW, INFO )
306          CALL CHKXER( 'CLATPS', INFOT, NOUT, LERR, OK )
307          INFOT = 5
308          CALL CLATPS( 'U''N''N''N'-1, A, X, SCALE, RW, INFO )
309          CALL CHKXER( 'CLATPS', INFOT, NOUT, LERR, OK )
310 *
311 *     Test error exits for the banded triangular routines.
312 *
313       ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN
314 *
315 *        CTBTRS
316 *
317          SRNAMT = 'CTBTRS'
318          INFOT = 1
319          CALL CTBTRS( '/''N''N'000, A, 1, X, 1, INFO )
320          CALL CHKXER( 'CTBTRS', INFOT, NOUT, LERR, OK )
321          INFOT = 2
322          CALL CTBTRS( 'U''/''N'000, A, 1, X, 1, INFO )
323          CALL CHKXER( 'CTBTRS', INFOT, NOUT, LERR, OK )
324          INFOT = 3
325          CALL CTBTRS( 'U''N''/'000, A, 1, X, 1, INFO )
326          CALL CHKXER( 'CTBTRS', INFOT, NOUT, LERR, OK )
327          INFOT = 4
328          CALL CTBTRS( 'U''N''N'-100, A, 1, X, 1, INFO )
329          CALL CHKXER( 'CTBTRS', INFOT, NOUT, LERR, OK )
330          INFOT = 5
331          CALL CTBTRS( 'U''N''N'0-10, A, 1, X, 1, INFO )
332          CALL CHKXER( 'CTBTRS', INFOT, NOUT, LERR, OK )
333          INFOT = 6
334          CALL CTBTRS( 'U''N''N'00-1, A, 1, X, 1, INFO )
335          CALL CHKXER( 'CTBTRS', INFOT, NOUT, LERR, OK )
336          INFOT = 8
337          CALL CTBTRS( 'U''N''N'211, A, 1, X, 2, INFO )
338          CALL CHKXER( 'CTBTRS', INFOT, NOUT, LERR, OK )
339          INFOT = 10
340          CALL CTBTRS( 'U''N''N'201, A, 1, X, 1, INFO )
341          CALL CHKXER( 'CTBTRS', INFOT, NOUT, LERR, OK )
342 *
343 *        CTBRFS
344 *
345          SRNAMT = 'CTBRFS'
346          INFOT = 1
347          CALL CTBRFS( '/''N''N'000, A, 1, B, 1, X, 1, R1, R2,
348      $                W, RW, INFO )
349          CALL CHKXER( 'CTBRFS', INFOT, NOUT, LERR, OK )
350          INFOT = 2
351          CALL CTBRFS( 'U''/''N'000, A, 1, B, 1, X, 1, R1, R2,
352      $                W, RW, INFO )
353          CALL CHKXER( 'CTBRFS', INFOT, NOUT, LERR, OK )
354          INFOT = 3
355          CALL CTBRFS( 'U''N''/'000, A, 1, B, 1, X, 1, R1, R2,
356      $                W, RW, INFO )
357          CALL CHKXER( 'CTBRFS', INFOT, NOUT, LERR, OK )
358          INFOT = 4
359          CALL CTBRFS( 'U''N''N'-100, A, 1, B, 1, X, 1, R1, R2,
360      $                W, RW, INFO )
361          CALL CHKXER( 'CTBRFS', INFOT, NOUT, LERR, OK )
362          INFOT = 5
363          CALL CTBRFS( 'U''N''N'0-10, A, 1, B, 1, X, 1, R1, R2,
364      $                W, RW, INFO )
365          CALL CHKXER( 'CTBRFS', INFOT, NOUT, LERR, OK )
366          INFOT = 6
367          CALL CTBRFS( 'U''N''N'00-1, A, 1, B, 1, X, 1, R1, R2,
368      $                W, RW, INFO )
369          CALL CHKXER( 'CTBRFS', INFOT, NOUT, LERR, OK )
370          INFOT = 8
371          CALL CTBRFS( 'U''N''N'211, A, 1, B, 2, X, 2, R1, R2,
372      $                W, RW, INFO )
373          CALL CHKXER( 'CTBRFS', INFOT, NOUT, LERR, OK )
374          INFOT = 10
375          CALL CTBRFS( 'U''N''N'211, A, 2, B, 1, X, 2, R1, R2,
376      $                W, RW, INFO )
377          CALL CHKXER( 'CTBRFS', INFOT, NOUT, LERR, OK )
378          INFOT = 12
379          CALL CTBRFS( 'U''N''N'211, A, 2, B, 2, X, 1, R1, R2,
380      $                W, RW, INFO )
381          CALL CHKXER( 'CTBRFS', INFOT, NOUT, LERR, OK )
382 *
383 *        CTBCON
384 *
385          SRNAMT = 'CTBCON'
386          INFOT = 1
387          CALL CTBCON( '/''U''N'00, A, 1, RCOND, W, RW, INFO )
388          CALL CHKXER( 'CTBCON', INFOT, NOUT, LERR, OK )
389          INFOT = 2
390          CALL CTBCON( '1''/''N'00, A, 1, RCOND, W, RW, INFO )
391          CALL CHKXER( 'CTBCON', INFOT, NOUT, LERR, OK )
392          INFOT = 3
393          CALL CTBCON( '1''U''/'00, A, 1, RCOND, W, RW, INFO )
394          CALL CHKXER( 'CTBCON', INFOT, NOUT, LERR, OK )
395          INFOT = 4
396          CALL CTBCON( '1''U''N'-10, A, 1, RCOND, W, RW, INFO )
397          CALL CHKXER( 'CTBCON', INFOT, NOUT, LERR, OK )
398          INFOT = 5
399          CALL CTBCON( '1''U''N'0-1, A, 1, RCOND, W, RW, INFO )
400          CALL CHKXER( 'CTBCON', INFOT, NOUT, LERR, OK )
401          INFOT = 7
402          CALL CTBCON( '1''U''N'21, A, 1, RCOND, W, RW, INFO )
403          CALL CHKXER( 'CTBCON', INFOT, NOUT, LERR, OK )
404 *
405 *        CLATBS
406 *
407          SRNAMT = 'CLATBS'
408          INFOT = 1
409          CALL CLATBS( '/''N''N''N'00, A, 1, X, SCALE, RW,
410      $                INFO )
411          CALL CHKXER( 'CLATBS', INFOT, NOUT, LERR, OK )
412          INFOT = 2
413          CALL CLATBS( 'U''/''N''N'00, A, 1, X, SCALE, RW,
414      $                INFO )
415          CALL CHKXER( 'CLATBS', INFOT, NOUT, LERR, OK )
416          INFOT = 3
417          CALL CLATBS( 'U''N''/''N'00, A, 1, X, SCALE, RW,
418      $                INFO )
419          CALL CHKXER( 'CLATBS', INFOT, NOUT, LERR, OK )
420          INFOT = 4
421          CALL CLATBS( 'U''N''N''/'00, A, 1, X, SCALE, RW,
422      $                INFO )
423          CALL CHKXER( 'CLATBS', INFOT, NOUT, LERR, OK )
424          INFOT = 5
425          CALL CLATBS( 'U''N''N''N'-10, A, 1, X, SCALE, RW,
426      $                INFO )
427          CALL CHKXER( 'CLATBS', INFOT, NOUT, LERR, OK )
428          INFOT = 6
429          CALL CLATBS( 'U''N''N''N'1-1, A, 1, X, SCALE, RW,
430      $                INFO )
431          CALL CHKXER( 'CLATBS', INFOT, NOUT, LERR, OK )
432          INFOT = 8
433          CALL CLATBS( 'U''N''N''N'21, A, 1, X, SCALE, RW,
434      $                INFO )
435          CALL CHKXER( 'CLATBS', INFOT, NOUT, LERR, OK )
436       END IF
437 *
438 *     Print a summary line.
439 *
440       CALL ALAESM( PATH, OK, NOUT )
441 *
442       RETURN
443 *
444 *     End of CERRTR
445 *
446       END