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