LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
derrvx.f
Go to the documentation of this file.
1 *> \brief \b DERRVX
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 DERRVX( 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 *> DERRVX tests the error exits for the DOUBLE PRECISION driver routines
25 *> for solving linear systems of equations.
26 *> \endverbatim
27 *
28 * Arguments:
29 * ==========
30 *
31 *> \param[in] PATH
32 *> \verbatim
33 *> PATH is CHARACTER*3
34 *> The LAPACK path name for the routines to be tested.
35 *> \endverbatim
36 *>
37 *> \param[in] NUNIT
38 *> \verbatim
39 *> NUNIT is INTEGER
40 *> The unit number for output.
41 *> \endverbatim
42 *
43 * Authors:
44 * ========
45 *
46 *> \author Univ. of Tennessee
47 *> \author Univ. of California Berkeley
48 *> \author Univ. of Colorado Denver
49 *> \author NAG Ltd.
50 *
51 *> \date April 2012
52 *
53 *> \ingroup double_lin
54 *
55 * =====================================================================
56  SUBROUTINE derrvx( PATH, NUNIT )
57 *
58 * -- LAPACK test routine (version 3.4.1) --
59 * -- LAPACK is a software package provided by Univ. of Tennessee, --
60 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61 * April 2012
62 *
63 * .. Scalar Arguments ..
64  CHARACTER*3 PATH
65  INTEGER NUNIT
66 * ..
67 *
68 * =====================================================================
69 *
70 * .. Parameters ..
71  INTEGER NMAX
72  parameter ( nmax = 4 )
73 * ..
74 * .. Local Scalars ..
75  CHARACTER EQ
76  CHARACTER*2 C2
77  INTEGER I, INFO, J
78  DOUBLE PRECISION RCOND
79 * ..
80 * .. Local Arrays ..
81  INTEGER IP( nmax ), IW( nmax )
82  DOUBLE PRECISION A( nmax, nmax ), AF( nmax, nmax ), B( nmax ),
83  $ c( nmax ), r( nmax ), r1( nmax ), r2( nmax ),
84  $ w( 2*nmax ), x( nmax )
85 * ..
86 * .. External Functions ..
87  LOGICAL LSAMEN
88  EXTERNAL lsamen
89 * ..
90 * .. External Subroutines ..
91  EXTERNAL chkxer, dgbsv, dgbsvx, dgesv, dgesvx, dgtsv,
95 * ..
96 * .. Scalars in Common ..
97  LOGICAL LERR, OK
98  CHARACTER*32 SRNAMT
99  INTEGER INFOT, NOUT
100 * ..
101 * .. Common blocks ..
102  COMMON / infoc / infot, nout, ok, lerr
103  COMMON / srnamc / srnamt
104 * ..
105 * .. Intrinsic Functions ..
106  INTRINSIC dble
107 * ..
108 * .. Executable Statements ..
109 *
110  nout = nunit
111  WRITE( nout, fmt = * )
112  c2 = path( 2: 3 )
113 *
114 * Set the variables to innocuous values.
115 *
116  DO 20 j = 1, nmax
117  DO 10 i = 1, nmax
118  a( i, j ) = 1.d0 / dble( i+j )
119  af( i, j ) = 1.d0 / dble( i+j )
120  10 CONTINUE
121  b( j ) = 0.d0
122  r1( j ) = 0.d0
123  r2( j ) = 0.d0
124  w( j ) = 0.d0
125  x( j ) = 0.d0
126  c( j ) = 0.d0
127  r( j ) = 0.d0
128  ip( j ) = j
129  20 CONTINUE
130  eq = ' '
131  ok = .true.
132 *
133  IF( lsamen( 2, c2, 'GE' ) ) THEN
134 *
135 * DGESV
136 *
137  srnamt = 'DGESV '
138  infot = 1
139  CALL dgesv( -1, 0, a, 1, ip, b, 1, info )
140  CALL chkxer( 'DGESV ', infot, nout, lerr, ok )
141  infot = 2
142  CALL dgesv( 0, -1, a, 1, ip, b, 1, info )
143  CALL chkxer( 'DGESV ', infot, nout, lerr, ok )
144  infot = 4
145  CALL dgesv( 2, 1, a, 1, ip, b, 2, info )
146  CALL chkxer( 'DGESV ', infot, nout, lerr, ok )
147  infot = 7
148  CALL dgesv( 2, 1, a, 2, ip, b, 1, info )
149  CALL chkxer( 'DGESV ', infot, nout, lerr, ok )
150 *
151 * DGESVX
152 *
153  srnamt = 'DGESVX'
154  infot = 1
155  CALL dgesvx( '/', 'N', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
156  $ x, 1, rcond, r1, r2, w, iw, info )
157  CALL chkxer( 'DGESVX', infot, nout, lerr, ok )
158  infot = 2
159  CALL dgesvx( 'N', '/', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
160  $ x, 1, rcond, r1, r2, w, iw, info )
161  CALL chkxer( 'DGESVX', infot, nout, lerr, ok )
162  infot = 3
163  CALL dgesvx( 'N', 'N', -1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
164  $ x, 1, rcond, r1, r2, w, iw, info )
165  CALL chkxer( 'DGESVX', infot, nout, lerr, ok )
166  infot = 4
167  CALL dgesvx( 'N', 'N', 0, -1, a, 1, af, 1, ip, eq, r, c, b, 1,
168  $ x, 1, rcond, r1, r2, w, iw, info )
169  CALL chkxer( 'DGESVX', infot, nout, lerr, ok )
170  infot = 6
171  CALL dgesvx( 'N', 'N', 2, 1, a, 1, af, 2, ip, eq, r, c, b, 2,
172  $ x, 2, rcond, r1, r2, w, iw, info )
173  CALL chkxer( 'DGESVX', infot, nout, lerr, ok )
174  infot = 8
175  CALL dgesvx( 'N', 'N', 2, 1, a, 2, af, 1, ip, eq, r, c, b, 2,
176  $ x, 2, rcond, r1, r2, w, iw, info )
177  CALL chkxer( 'DGESVX', infot, nout, lerr, ok )
178  infot = 10
179  eq = '/'
180  CALL dgesvx( 'F', 'N', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
181  $ x, 1, rcond, r1, r2, w, iw, info )
182  CALL chkxer( 'DGESVX', infot, nout, lerr, ok )
183  infot = 11
184  eq = 'R'
185  CALL dgesvx( 'F', 'N', 1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
186  $ x, 1, rcond, r1, r2, w, iw, info )
187  CALL chkxer( 'DGESVX', infot, nout, lerr, ok )
188  infot = 12
189  eq = 'C'
190  CALL dgesvx( 'F', 'N', 1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
191  $ x, 1, rcond, r1, r2, w, iw, info )
192  CALL chkxer( 'DGESVX', infot, nout, lerr, ok )
193  infot = 14
194  CALL dgesvx( 'N', 'N', 2, 1, a, 2, af, 2, ip, eq, r, c, b, 1,
195  $ x, 2, rcond, r1, r2, w, iw, info )
196  CALL chkxer( 'DGESVX', infot, nout, lerr, ok )
197  infot = 16
198  CALL dgesvx( 'N', 'N', 2, 1, a, 2, af, 2, ip, eq, r, c, b, 2,
199  $ x, 1, rcond, r1, r2, w, iw, info )
200  CALL chkxer( 'DGESVX', infot, nout, lerr, ok )
201 *
202  ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
203 *
204 * DGBSV
205 *
206  srnamt = 'DGBSV '
207  infot = 1
208  CALL dgbsv( -1, 0, 0, 0, a, 1, ip, b, 1, info )
209  CALL chkxer( 'DGBSV ', infot, nout, lerr, ok )
210  infot = 2
211  CALL dgbsv( 1, -1, 0, 0, a, 1, ip, b, 1, info )
212  CALL chkxer( 'DGBSV ', infot, nout, lerr, ok )
213  infot = 3
214  CALL dgbsv( 1, 0, -1, 0, a, 1, ip, b, 1, info )
215  CALL chkxer( 'DGBSV ', infot, nout, lerr, ok )
216  infot = 4
217  CALL dgbsv( 0, 0, 0, -1, a, 1, ip, b, 1, info )
218  CALL chkxer( 'DGBSV ', infot, nout, lerr, ok )
219  infot = 6
220  CALL dgbsv( 1, 1, 1, 0, a, 3, ip, b, 1, info )
221  CALL chkxer( 'DGBSV ', infot, nout, lerr, ok )
222  infot = 9
223  CALL dgbsv( 2, 0, 0, 0, a, 1, ip, b, 1, info )
224  CALL chkxer( 'DGBSV ', infot, nout, lerr, ok )
225 *
226 * DGBSVX
227 *
228  srnamt = 'DGBSVX'
229  infot = 1
230  CALL dgbsvx( '/', 'N', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
231  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
232  CALL chkxer( 'DGBSVX', infot, nout, lerr, ok )
233  infot = 2
234  CALL dgbsvx( 'N', '/', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
235  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
236  CALL chkxer( 'DGBSVX', infot, nout, lerr, ok )
237  infot = 3
238  CALL dgbsvx( 'N', 'N', -1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
239  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
240  CALL chkxer( 'DGBSVX', infot, nout, lerr, ok )
241  infot = 4
242  CALL dgbsvx( 'N', 'N', 1, -1, 0, 0, a, 1, af, 1, ip, eq, r, c,
243  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
244  CALL chkxer( 'DGBSVX', infot, nout, lerr, ok )
245  infot = 5
246  CALL dgbsvx( 'N', 'N', 1, 0, -1, 0, a, 1, af, 1, ip, eq, r, c,
247  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
248  CALL chkxer( 'DGBSVX', infot, nout, lerr, ok )
249  infot = 6
250  CALL dgbsvx( 'N', 'N', 0, 0, 0, -1, a, 1, af, 1, ip, eq, r, c,
251  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
252  CALL chkxer( 'DGBSVX', infot, nout, lerr, ok )
253  infot = 8
254  CALL dgbsvx( 'N', 'N', 1, 1, 1, 0, a, 2, af, 4, ip, eq, r, c,
255  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
256  CALL chkxer( 'DGBSVX', infot, nout, lerr, ok )
257  infot = 10
258  CALL dgbsvx( 'N', 'N', 1, 1, 1, 0, a, 3, af, 3, ip, eq, r, c,
259  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
260  CALL chkxer( 'DGBSVX', infot, nout, lerr, ok )
261  infot = 12
262  eq = '/'
263  CALL dgbsvx( 'F', 'N', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
264  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
265  CALL chkxer( 'DGBSVX', infot, nout, lerr, ok )
266  infot = 13
267  eq = 'R'
268  CALL dgbsvx( 'F', 'N', 1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
269  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
270  CALL chkxer( 'DGBSVX', infot, nout, lerr, ok )
271  infot = 14
272  eq = 'C'
273  CALL dgbsvx( 'F', 'N', 1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
274  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
275  CALL chkxer( 'DGBSVX', infot, nout, lerr, ok )
276  infot = 16
277  CALL dgbsvx( 'N', 'N', 2, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
278  $ b, 1, x, 2, rcond, r1, r2, w, iw, info )
279  CALL chkxer( 'DGBSVX', infot, nout, lerr, ok )
280  infot = 18
281  CALL dgbsvx( 'N', 'N', 2, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
282  $ b, 2, x, 1, rcond, r1, r2, w, iw, info )
283  CALL chkxer( 'DGBSVX', infot, nout, lerr, ok )
284 *
285  ELSE IF( lsamen( 2, c2, 'GT' ) ) THEN
286 *
287 * DGTSV
288 *
289  srnamt = 'DGTSV '
290  infot = 1
291  CALL dgtsv( -1, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1,
292  $ info )
293  CALL chkxer( 'DGTSV ', infot, nout, lerr, ok )
294  infot = 2
295  CALL dgtsv( 0, -1, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1,
296  $ info )
297  CALL chkxer( 'DGTSV ', infot, nout, lerr, ok )
298  infot = 7
299  CALL dgtsv( 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1, info )
300  CALL chkxer( 'DGTSV ', infot, nout, lerr, ok )
301 *
302 * DGTSVX
303 *
304  srnamt = 'DGTSVX'
305  infot = 1
306  CALL dgtsvx( '/', 'N', 0, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
307  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
308  $ ip, b, 1, x, 1, rcond, r1, r2, w, iw, info )
309  CALL chkxer( 'DGTSVX', infot, nout, lerr, ok )
310  infot = 2
311  CALL dgtsvx( 'N', '/', 0, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
312  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
313  $ ip, b, 1, x, 1, rcond, r1, r2, w, iw, info )
314  CALL chkxer( 'DGTSVX', infot, nout, lerr, ok )
315  infot = 3
316  CALL dgtsvx( 'N', 'N', -1, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
317  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
318  $ ip, b, 1, x, 1, rcond, r1, r2, w, iw, info )
319  CALL chkxer( 'DGTSVX', infot, nout, lerr, ok )
320  infot = 4
321  CALL dgtsvx( 'N', 'N', 0, -1, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
322  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
323  $ ip, b, 1, x, 1, rcond, r1, r2, w, iw, info )
324  CALL chkxer( 'DGTSVX', infot, nout, lerr, ok )
325  infot = 14
326  CALL dgtsvx( 'N', 'N', 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
327  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
328  $ ip, b, 1, x, 2, rcond, r1, r2, w, iw, info )
329  CALL chkxer( 'DGTSVX', infot, nout, lerr, ok )
330  infot = 16
331  CALL dgtsvx( 'N', 'N', 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
332  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
333  $ ip, b, 2, x, 1, rcond, r1, r2, w, iw, info )
334  CALL chkxer( 'DGTSVX', infot, nout, lerr, ok )
335 *
336  ELSE IF( lsamen( 2, c2, 'PO' ) ) THEN
337 *
338 * DPOSV
339 *
340  srnamt = 'DPOSV '
341  infot = 1
342  CALL dposv( '/', 0, 0, a, 1, b, 1, info )
343  CALL chkxer( 'DPOSV ', infot, nout, lerr, ok )
344  infot = 2
345  CALL dposv( 'U', -1, 0, a, 1, b, 1, info )
346  CALL chkxer( 'DPOSV ', infot, nout, lerr, ok )
347  infot = 3
348  CALL dposv( 'U', 0, -1, a, 1, b, 1, info )
349  CALL chkxer( 'DPOSV ', infot, nout, lerr, ok )
350  infot = 5
351  CALL dposv( 'U', 2, 0, a, 1, b, 2, info )
352  CALL chkxer( 'DPOSV ', infot, nout, lerr, ok )
353  infot = 7
354  CALL dposv( 'U', 2, 0, a, 2, b, 1, info )
355  CALL chkxer( 'DPOSV ', infot, nout, lerr, ok )
356 *
357 * DPOSVX
358 *
359  srnamt = 'DPOSVX'
360  infot = 1
361  CALL dposvx( '/', 'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
362  $ rcond, r1, r2, w, iw, info )
363  CALL chkxer( 'DPOSVX', infot, nout, lerr, ok )
364  infot = 2
365  CALL dposvx( 'N', '/', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
366  $ rcond, r1, r2, w, iw, info )
367  CALL chkxer( 'DPOSVX', infot, nout, lerr, ok )
368  infot = 3
369  CALL dposvx( 'N', 'U', -1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
370  $ rcond, r1, r2, w, iw, info )
371  CALL chkxer( 'DPOSVX', infot, nout, lerr, ok )
372  infot = 4
373  CALL dposvx( 'N', 'U', 0, -1, a, 1, af, 1, eq, c, b, 1, x, 1,
374  $ rcond, r1, r2, w, iw, info )
375  CALL chkxer( 'DPOSVX', infot, nout, lerr, ok )
376  infot = 6
377  CALL dposvx( 'N', 'U', 2, 0, a, 1, af, 2, eq, c, b, 2, x, 2,
378  $ rcond, r1, r2, w, iw, info )
379  CALL chkxer( 'DPOSVX', infot, nout, lerr, ok )
380  infot = 8
381  CALL dposvx( 'N', 'U', 2, 0, a, 2, af, 1, eq, c, b, 2, x, 2,
382  $ rcond, r1, r2, w, iw, info )
383  CALL chkxer( 'DPOSVX', infot, nout, lerr, ok )
384  infot = 9
385  eq = '/'
386  CALL dposvx( 'F', 'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
387  $ rcond, r1, r2, w, iw, info )
388  CALL chkxer( 'DPOSVX', infot, nout, lerr, ok )
389  infot = 10
390  eq = 'Y'
391  CALL dposvx( 'F', 'U', 1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
392  $ rcond, r1, r2, w, iw, info )
393  CALL chkxer( 'DPOSVX', infot, nout, lerr, ok )
394  infot = 12
395  CALL dposvx( 'N', 'U', 2, 0, a, 2, af, 2, eq, c, b, 1, x, 2,
396  $ rcond, r1, r2, w, iw, info )
397  CALL chkxer( 'DPOSVX', infot, nout, lerr, ok )
398  infot = 14
399  CALL dposvx( 'N', 'U', 2, 0, a, 2, af, 2, eq, c, b, 2, x, 1,
400  $ rcond, r1, r2, w, iw, info )
401  CALL chkxer( 'DPOSVX', infot, nout, lerr, ok )
402 *
403  ELSE IF( lsamen( 2, c2, 'PP' ) ) THEN
404 *
405 * DPPSV
406 *
407  srnamt = 'DPPSV '
408  infot = 1
409  CALL dppsv( '/', 0, 0, a, b, 1, info )
410  CALL chkxer( 'DPPSV ', infot, nout, lerr, ok )
411  infot = 2
412  CALL dppsv( 'U', -1, 0, a, b, 1, info )
413  CALL chkxer( 'DPPSV ', infot, nout, lerr, ok )
414  infot = 3
415  CALL dppsv( 'U', 0, -1, a, b, 1, info )
416  CALL chkxer( 'DPPSV ', infot, nout, lerr, ok )
417  infot = 6
418  CALL dppsv( 'U', 2, 0, a, b, 1, info )
419  CALL chkxer( 'DPPSV ', infot, nout, lerr, ok )
420 *
421 * DPPSVX
422 *
423  srnamt = 'DPPSVX'
424  infot = 1
425  CALL dppsvx( '/', 'U', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
426  $ r1, r2, w, iw, info )
427  CALL chkxer( 'DPPSVX', infot, nout, lerr, ok )
428  infot = 2
429  CALL dppsvx( 'N', '/', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
430  $ r1, r2, w, iw, info )
431  CALL chkxer( 'DPPSVX', infot, nout, lerr, ok )
432  infot = 3
433  CALL dppsvx( 'N', 'U', -1, 0, a, af, eq, c, b, 1, x, 1, rcond,
434  $ r1, r2, w, iw, info )
435  CALL chkxer( 'DPPSVX', infot, nout, lerr, ok )
436  infot = 4
437  CALL dppsvx( 'N', 'U', 0, -1, a, af, eq, c, b, 1, x, 1, rcond,
438  $ r1, r2, w, iw, info )
439  CALL chkxer( 'DPPSVX', infot, nout, lerr, ok )
440  infot = 7
441  eq = '/'
442  CALL dppsvx( 'F', 'U', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
443  $ r1, r2, w, iw, info )
444  CALL chkxer( 'DPPSVX', infot, nout, lerr, ok )
445  infot = 8
446  eq = 'Y'
447  CALL dppsvx( 'F', 'U', 1, 0, a, af, eq, c, b, 1, x, 1, rcond,
448  $ r1, r2, w, iw, info )
449  CALL chkxer( 'DPPSVX', infot, nout, lerr, ok )
450  infot = 10
451  CALL dppsvx( 'N', 'U', 2, 0, a, af, eq, c, b, 1, x, 2, rcond,
452  $ r1, r2, w, iw, info )
453  CALL chkxer( 'DPPSVX', infot, nout, lerr, ok )
454  infot = 12
455  CALL dppsvx( 'N', 'U', 2, 0, a, af, eq, c, b, 2, x, 1, rcond,
456  $ r1, r2, w, iw, info )
457  CALL chkxer( 'DPPSVX', infot, nout, lerr, ok )
458 *
459  ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
460 *
461 * DPBSV
462 *
463  srnamt = 'DPBSV '
464  infot = 1
465  CALL dpbsv( '/', 0, 0, 0, a, 1, b, 1, info )
466  CALL chkxer( 'DPBSV ', infot, nout, lerr, ok )
467  infot = 2
468  CALL dpbsv( 'U', -1, 0, 0, a, 1, b, 1, info )
469  CALL chkxer( 'DPBSV ', infot, nout, lerr, ok )
470  infot = 3
471  CALL dpbsv( 'U', 1, -1, 0, a, 1, b, 1, info )
472  CALL chkxer( 'DPBSV ', infot, nout, lerr, ok )
473  infot = 4
474  CALL dpbsv( 'U', 0, 0, -1, a, 1, b, 1, info )
475  CALL chkxer( 'DPBSV ', infot, nout, lerr, ok )
476  infot = 6
477  CALL dpbsv( 'U', 1, 1, 0, a, 1, b, 2, info )
478  CALL chkxer( 'DPBSV ', infot, nout, lerr, ok )
479  infot = 8
480  CALL dpbsv( 'U', 2, 0, 0, a, 1, b, 1, info )
481  CALL chkxer( 'DPBSV ', infot, nout, lerr, ok )
482 *
483 * DPBSVX
484 *
485  srnamt = 'DPBSVX'
486  infot = 1
487  CALL dpbsvx( '/', 'U', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
488  $ rcond, r1, r2, w, iw, info )
489  CALL chkxer( 'DPBSVX', infot, nout, lerr, ok )
490  infot = 2
491  CALL dpbsvx( 'N', '/', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
492  $ rcond, r1, r2, w, iw, info )
493  CALL chkxer( 'DPBSVX', infot, nout, lerr, ok )
494  infot = 3
495  CALL dpbsvx( 'N', 'U', -1, 0, 0, a, 1, af, 1, eq, c, b, 1, x,
496  $ 1, rcond, r1, r2, w, iw, info )
497  CALL chkxer( 'DPBSVX', infot, nout, lerr, ok )
498  infot = 4
499  CALL dpbsvx( 'N', 'U', 1, -1, 0, a, 1, af, 1, eq, c, b, 1, x,
500  $ 1, rcond, r1, r2, w, iw, info )
501  CALL chkxer( 'DPBSVX', infot, nout, lerr, ok )
502  infot = 5
503  CALL dpbsvx( 'N', 'U', 0, 0, -1, a, 1, af, 1, eq, c, b, 1, x,
504  $ 1, rcond, r1, r2, w, iw, info )
505  CALL chkxer( 'DPBSVX', infot, nout, lerr, ok )
506  infot = 7
507  CALL dpbsvx( 'N', 'U', 1, 1, 0, a, 1, af, 2, eq, c, b, 2, x, 2,
508  $ rcond, r1, r2, w, iw, info )
509  CALL chkxer( 'DPBSVX', infot, nout, lerr, ok )
510  infot = 9
511  CALL dpbsvx( 'N', 'U', 1, 1, 0, a, 2, af, 1, eq, c, b, 2, x, 2,
512  $ rcond, r1, r2, w, iw, info )
513  CALL chkxer( 'DPBSVX', infot, nout, lerr, ok )
514  infot = 10
515  eq = '/'
516  CALL dpbsvx( 'F', 'U', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
517  $ rcond, r1, r2, w, iw, info )
518  CALL chkxer( 'DPBSVX', infot, nout, lerr, ok )
519  infot = 11
520  eq = 'Y'
521  CALL dpbsvx( 'F', 'U', 1, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
522  $ rcond, r1, r2, w, iw, info )
523  CALL chkxer( 'DPBSVX', infot, nout, lerr, ok )
524  infot = 13
525  CALL dpbsvx( 'N', 'U', 2, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 2,
526  $ rcond, r1, r2, w, iw, info )
527  CALL chkxer( 'DPBSVX', infot, nout, lerr, ok )
528  infot = 15
529  CALL dpbsvx( 'N', 'U', 2, 0, 0, a, 1, af, 1, eq, c, b, 2, x, 1,
530  $ rcond, r1, r2, w, iw, info )
531  CALL chkxer( 'DPBSVX', infot, nout, lerr, ok )
532 *
533  ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
534 *
535 * DPTSV
536 *
537  srnamt = 'DPTSV '
538  infot = 1
539  CALL dptsv( -1, 0, a( 1, 1 ), a( 1, 2 ), b, 1, info )
540  CALL chkxer( 'DPTSV ', infot, nout, lerr, ok )
541  infot = 2
542  CALL dptsv( 0, -1, a( 1, 1 ), a( 1, 2 ), b, 1, info )
543  CALL chkxer( 'DPTSV ', infot, nout, lerr, ok )
544  infot = 6
545  CALL dptsv( 2, 0, a( 1, 1 ), a( 1, 2 ), b, 1, info )
546  CALL chkxer( 'DPTSV ', infot, nout, lerr, ok )
547 *
548 * DPTSVX
549 *
550  srnamt = 'DPTSVX'
551  infot = 1
552  CALL dptsvx( '/', 0, 0, a( 1, 1 ), a( 1, 2 ), af( 1, 1 ),
553  $ af( 1, 2 ), b, 1, x, 1, rcond, r1, r2, w, info )
554  CALL chkxer( 'DPTSVX', infot, nout, lerr, ok )
555  infot = 2
556  CALL dptsvx( 'N', -1, 0, a( 1, 1 ), a( 1, 2 ), af( 1, 1 ),
557  $ af( 1, 2 ), b, 1, x, 1, rcond, r1, r2, w, info )
558  CALL chkxer( 'DPTSVX', infot, nout, lerr, ok )
559  infot = 3
560  CALL dptsvx( 'N', 0, -1, a( 1, 1 ), a( 1, 2 ), af( 1, 1 ),
561  $ af( 1, 2 ), b, 1, x, 1, rcond, r1, r2, w, info )
562  CALL chkxer( 'DPTSVX', infot, nout, lerr, ok )
563  infot = 9
564  CALL dptsvx( 'N', 2, 0, a( 1, 1 ), a( 1, 2 ), af( 1, 1 ),
565  $ af( 1, 2 ), b, 1, x, 2, rcond, r1, r2, w, info )
566  CALL chkxer( 'DPTSVX', infot, nout, lerr, ok )
567  infot = 11
568  CALL dptsvx( 'N', 2, 0, a( 1, 1 ), a( 1, 2 ), af( 1, 1 ),
569  $ af( 1, 2 ), b, 2, x, 1, rcond, r1, r2, w, info )
570  CALL chkxer( 'DPTSVX', infot, nout, lerr, ok )
571 *
572  ELSE IF( lsamen( 2, c2, 'SY' ) ) THEN
573 *
574 * DSYSV
575 *
576  srnamt = 'DSYSV '
577  infot = 1
578  CALL dsysv( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
579  CALL chkxer( 'DSYSV ', infot, nout, lerr, ok )
580  infot = 2
581  CALL dsysv( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
582  CALL chkxer( 'DSYSV ', infot, nout, lerr, ok )
583  infot = 3
584  CALL dsysv( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
585  CALL chkxer( 'DSYSV ', infot, nout, lerr, ok )
586  infot = 8
587  CALL dsysv( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
588  CALL chkxer( 'DSYSV ', infot, nout, lerr, ok )
589 *
590 * DSYSVX
591 *
592  srnamt = 'DSYSVX'
593  infot = 1
594  CALL dsysvx( '/', 'U', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
595  $ rcond, r1, r2, w, 1, iw, info )
596  CALL chkxer( 'DSYSVX', infot, nout, lerr, ok )
597  infot = 2
598  CALL dsysvx( 'N', '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
599  $ rcond, r1, r2, w, 1, iw, info )
600  CALL chkxer( 'DSYSVX', infot, nout, lerr, ok )
601  infot = 3
602  CALL dsysvx( 'N', 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1,
603  $ rcond, r1, r2, w, 1, iw, info )
604  CALL chkxer( 'DSYSVX', infot, nout, lerr, ok )
605  infot = 4
606  CALL dsysvx( 'N', 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1,
607  $ rcond, r1, r2, w, 1, iw, info )
608  CALL chkxer( 'DSYSVX', infot, nout, lerr, ok )
609  infot = 6
610  CALL dsysvx( 'N', 'U', 2, 0, a, 1, af, 2, ip, b, 2, x, 2,
611  $ rcond, r1, r2, w, 4, iw, info )
612  CALL chkxer( 'DSYSVX', infot, nout, lerr, ok )
613  infot = 8
614  CALL dsysvx( 'N', 'U', 2, 0, a, 2, af, 1, ip, b, 2, x, 2,
615  $ rcond, r1, r2, w, 4, iw, info )
616  CALL chkxer( 'DSYSVX', infot, nout, lerr, ok )
617  infot = 11
618  CALL dsysvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 1, x, 2,
619  $ rcond, r1, r2, w, 4, iw, info )
620  CALL chkxer( 'DSYSVX', infot, nout, lerr, ok )
621  infot = 13
622  CALL dsysvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 1,
623  $ rcond, r1, r2, w, 4, iw, info )
624  CALL chkxer( 'DSYSVX', infot, nout, lerr, ok )
625  infot = 18
626  CALL dsysvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 2,
627  $ rcond, r1, r2, w, 3, iw, info )
628  CALL chkxer( 'DSYSVX', infot, nout, lerr, ok )
629 *
630  ELSE IF( lsamen( 2, c2, 'SR' ) ) THEN
631 *
632 * DSYSV_ROOK
633 *
634  srnamt = 'DSYSV_ROOK'
635  infot = 1
636  CALL dsysv_rook( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
637  CALL chkxer( 'DSYSV_ROOK', infot, nout, lerr, ok )
638  infot = 2
639  CALL dsysv_rook( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
640  CALL chkxer( 'DSYSV_ROOK', infot, nout, lerr, ok )
641  infot = 3
642  CALL dsysv_rook( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
643  CALL chkxer( 'DSYSV_ROOK', infot, nout, lerr, ok )
644  infot = 8
645  CALL dsysv_rook( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
646  CALL chkxer( 'DSYSV_ROOK', infot, nout, lerr, ok )
647 *
648  ELSE IF( lsamen( 2, c2, 'SP' ) ) THEN
649 *
650 * DSPSV
651 *
652  srnamt = 'DSPSV '
653  infot = 1
654  CALL dspsv( '/', 0, 0, a, ip, b, 1, info )
655  CALL chkxer( 'DSPSV ', infot, nout, lerr, ok )
656  infot = 2
657  CALL dspsv( 'U', -1, 0, a, ip, b, 1, info )
658  CALL chkxer( 'DSPSV ', infot, nout, lerr, ok )
659  infot = 3
660  CALL dspsv( 'U', 0, -1, a, ip, b, 1, info )
661  CALL chkxer( 'DSPSV ', infot, nout, lerr, ok )
662  infot = 7
663  CALL dspsv( 'U', 2, 0, a, ip, b, 1, info )
664  CALL chkxer( 'DSPSV ', infot, nout, lerr, ok )
665 *
666 * DSPSVX
667 *
668  srnamt = 'DSPSVX'
669  infot = 1
670  CALL dspsvx( '/', 'U', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
671  $ r2, w, iw, info )
672  CALL chkxer( 'DSPSVX', infot, nout, lerr, ok )
673  infot = 2
674  CALL dspsvx( 'N', '/', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
675  $ r2, w, iw, info )
676  CALL chkxer( 'DSPSVX', infot, nout, lerr, ok )
677  infot = 3
678  CALL dspsvx( 'N', 'U', -1, 0, a, af, ip, b, 1, x, 1, rcond, r1,
679  $ r2, w, iw, info )
680  CALL chkxer( 'DSPSVX', infot, nout, lerr, ok )
681  infot = 4
682  CALL dspsvx( 'N', 'U', 0, -1, a, af, ip, b, 1, x, 1, rcond, r1,
683  $ r2, w, iw, info )
684  CALL chkxer( 'DSPSVX', infot, nout, lerr, ok )
685  infot = 9
686  CALL dspsvx( 'N', 'U', 2, 0, a, af, ip, b, 1, x, 2, rcond, r1,
687  $ r2, w, iw, info )
688  CALL chkxer( 'DSPSVX', infot, nout, lerr, ok )
689  infot = 11
690  CALL dspsvx( 'N', 'U', 2, 0, a, af, ip, b, 2, x, 1, rcond, r1,
691  $ r2, w, iw, info )
692  CALL chkxer( 'DSPSVX', infot, nout, lerr, ok )
693  END IF
694 *
695 * Print a summary line.
696 *
697  IF( ok ) THEN
698  WRITE( nout, fmt = 9999 )path
699  ELSE
700  WRITE( nout, fmt = 9998 )path
701  END IF
702 *
703  9999 FORMAT( 1x, a3, ' drivers passed the tests of the error exits' )
704  9998 FORMAT( ' *** ', a3, ' drivers failed the tests of the error ',
705  $ 'exits ***' )
706 *
707  RETURN
708 *
709 * End of DERRVX
710 *
711  END
subroutine dgtsv(N, NRHS, DL, D, DU, B, LDB, INFO)
DGTSV computes the solution to system of linear equations A * X = B for GT matrices ...
Definition: dgtsv.f:129
subroutine dspsv(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
DSPSV computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: dspsv.f:164
subroutine dspsvx(FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
DSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: dspsvx.f:279
subroutine dposv(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
DPOSV computes the solution to system of linear equations A * X = B for PO matrices ...
Definition: dposv.f:132
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
subroutine dgesvx(FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
DGESVX computes the solution to system of linear equations A * X = B for GE matrices ...
Definition: dgesvx.f:351
subroutine dpbsv(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
DPBSV computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: dpbsv.f:166
subroutine dppsv(UPLO, N, NRHS, AP, B, LDB, INFO)
DPPSV computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: dppsv.f:146
subroutine dgesv(N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DGESV computes the solution to system of linear equations A * X = B for GE matrices ...
Definition: dgesv.f:124
subroutine dppsvx(FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
DPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: dppsvx.f:314
subroutine dpbsvx(FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
DPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: dpbsvx.f:345
subroutine derrvx(PATH, NUNIT)
DERRVX
Definition: derrvx.f:57
subroutine dgbsvx(FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
DGBSVX computes the solution to system of linear equations A * X = B for GB matrices ...
Definition: dgbsvx.f:371
subroutine dgtsvx(FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
DGTSVX computes the solution to system of linear equations A * X = B for GT matrices ...
Definition: dgtsvx.f:295
subroutine dsysvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, IWORK, INFO)
DSYSVX computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: dsysvx.f:286
subroutine dsysv_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
DSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: dsysv_rook.f:206
subroutine dgbsv(N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
DGBSV computes the solution to system of linear equations A * X = B for GB matrices (simple driver) ...
Definition: dgbsv.f:164
subroutine dposvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
DPOSVX computes the solution to system of linear equations A * X = B for PO matrices ...
Definition: dposvx.f:309
subroutine dptsvx(FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, INFO)
DPTSVX computes the solution to system of linear equations A * X = B for PT matrices ...
Definition: dptsvx.f:230
subroutine dptsv(N, NRHS, D, E, B, LDB, INFO)
DPTSV computes the solution to system of linear equations A * X = B for PT matrices ...
Definition: dptsv.f:116
subroutine dsysv(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
DSYSV computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: dsysv.f:173