LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
serrvxx.f
Go to the documentation of this file.
1 *> \brief \b SERRVXX
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 SERRVX( 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 *> SERRVX tests the error exits for the REAL 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 November 2015
52 *
53 *> \ingroup single_lin
54 *
55 * =====================================================================
56  SUBROUTINE serrvx( PATH, NUNIT )
57 *
58 * -- LAPACK test routine (version 3.6.0) --
59 * -- LAPACK is a software package provided by Univ. of Tennessee, --
60 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61 * November 2015
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  REAL one
74  parameter ( one = 1.0e+0 )
75 * ..
76 * .. Local Scalars ..
77  CHARACTER eq
78  CHARACTER*2 c2
79  INTEGER i, info, j, n_err_bnds, nparams
80  REAL rcond, rpvgrw, berr
81 * ..
82 * .. Local Arrays ..
83  INTEGER ip( nmax ), iw( nmax )
84  REAL a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
85  $ c( nmax ), r( nmax ), r1( nmax ), r2( nmax ),
86  $ w( 2*nmax ), x( nmax ), err_bnds_n( nmax, 3 ),
87  $ err_bnds_c( nmax, 3 ), params( 1 )
88 * ..
89 * .. External Functions ..
90  LOGICAL lsamen
91  EXTERNAL lsamen
92 * ..
93 * .. External Subroutines ..
94  EXTERNAL chkxer, sgbsv, sgbsvx, sgesv, sgesvx, sgtsv,
98  $ sgbsvxx
99 * ..
100 * .. Scalars in Common ..
101  LOGICAL lerr, ok
102  CHARACTER*32 srnamt
103  INTEGER infot, nout
104 * ..
105 * .. Common blocks ..
106  COMMON / infoc / infot, nout, ok, lerr
107  COMMON / srnamc / srnamt
108 * ..
109 * .. Intrinsic Functions ..
110  INTRINSIC real
111 * ..
112 * .. Executable Statements ..
113 *
114  nout = nunit
115  WRITE( nout, fmt = * )
116  c2 = path( 2: 3 )
117 *
118 * Set the variables to innocuous values.
119 *
120  DO 20 j = 1, nmax
121  DO 10 i = 1, nmax
122  a( i, j ) = 1. / REAL( i+j )
123  af( i, j ) = 1. / REAL( i+j )
124  10 CONTINUE
125  b( j ) = 0.
126  r1( j ) = 0.
127  r2( j ) = 0.
128  w( j ) = 0.
129  x( j ) = 0.
130  c( j ) = 0.
131  r( j ) = 0.
132  ip( j ) = j
133  20 CONTINUE
134  eq = ' '
135  ok = .true.
136 *
137  IF( lsamen( 2, c2, 'GE' ) ) THEN
138 *
139 * SGESV
140 *
141  srnamt = 'SGESV '
142  infot = 1
143  CALL sgesv( -1, 0, a, 1, ip, b, 1, info )
144  CALL chkxer( 'SGESV ', infot, nout, lerr, ok )
145  infot = 2
146  CALL sgesv( 0, -1, a, 1, ip, b, 1, info )
147  CALL chkxer( 'SGESV ', infot, nout, lerr, ok )
148  infot = 4
149  CALL sgesv( 2, 1, a, 1, ip, b, 2, info )
150  CALL chkxer( 'SGESV ', infot, nout, lerr, ok )
151  infot = 7
152  CALL sgesv( 2, 1, a, 2, ip, b, 1, info )
153  CALL chkxer( 'SGESV ', infot, nout, lerr, ok )
154 *
155 * SGESVX
156 *
157  srnamt = 'SGESVX'
158  infot = 1
159  CALL sgesvx( '/', '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( 'SGESVX', infot, nout, lerr, ok )
162  infot = 2
163  CALL sgesvx( 'N', '/', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
164  $ x, 1, rcond, r1, r2, w, iw, info )
165  CALL chkxer( 'SGESVX', infot, nout, lerr, ok )
166  infot = 3
167  CALL sgesvx( 'N', 'N', -1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
168  $ x, 1, rcond, r1, r2, w, iw, info )
169  CALL chkxer( 'SGESVX', infot, nout, lerr, ok )
170  infot = 4
171  CALL sgesvx( 'N', 'N', 0, -1, a, 1, af, 1, ip, eq, r, c, b, 1,
172  $ x, 1, rcond, r1, r2, w, iw, info )
173  CALL chkxer( 'SGESVX', infot, nout, lerr, ok )
174  infot = 6
175  CALL sgesvx( 'N', 'N', 2, 1, a, 1, af, 2, ip, eq, r, c, b, 2,
176  $ x, 2, rcond, r1, r2, w, iw, info )
177  CALL chkxer( 'SGESVX', infot, nout, lerr, ok )
178  infot = 8
179  CALL sgesvx( 'N', 'N', 2, 1, a, 2, af, 1, ip, eq, r, c, b, 2,
180  $ x, 2, rcond, r1, r2, w, iw, info )
181  CALL chkxer( 'SGESVX', infot, nout, lerr, ok )
182  infot = 10
183  eq = '/'
184  CALL sgesvx( 'F', 'N', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
185  $ x, 1, rcond, r1, r2, w, iw, info )
186  CALL chkxer( 'SGESVX', infot, nout, lerr, ok )
187  infot = 11
188  eq = 'R'
189  CALL sgesvx( 'F', 'N', 1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
190  $ x, 1, rcond, r1, r2, w, iw, info )
191  CALL chkxer( 'SGESVX', infot, nout, lerr, ok )
192  infot = 12
193  eq = 'C'
194  CALL sgesvx( 'F', 'N', 1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
195  $ x, 1, rcond, r1, r2, w, iw, info )
196  CALL chkxer( 'SGESVX', infot, nout, lerr, ok )
197  infot = 14
198  CALL sgesvx( 'N', 'N', 2, 1, a, 2, af, 2, ip, eq, r, c, b, 1,
199  $ x, 2, rcond, r1, r2, w, iw, info )
200  CALL chkxer( 'SGESVX', infot, nout, lerr, ok )
201  infot = 16
202  CALL sgesvx( 'N', 'N', 2, 1, a, 2, af, 2, ip, eq, r, c, b, 2,
203  $ x, 1, rcond, r1, r2, w, iw, info )
204  CALL chkxer( 'SGESVX', infot, nout, lerr, ok )
205 *
206 * SGESVXX
207 *
208  n_err_bnds = 3
209  nparams = 1
210  srnamt = 'SGESVXX'
211  infot = 1
212  CALL sgesvxx( '/', 'N', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
213  $ x, 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
214  $ err_bnds_c, nparams, params, w, iw, info )
215  CALL chkxer( 'SGESVXX', infot, nout, lerr, ok )
216  infot = 2
217  CALL sgesvxx( 'N', '/', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
218  $ x, 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
219  $ err_bnds_c, nparams, params, w, iw, info )
220  CALL chkxer( 'SGESVXX', infot, nout, lerr, ok )
221  infot = 3
222  CALL sgesvxx( 'N', 'N', -1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
223  $ x, 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
224  $ err_bnds_c, nparams, params, w, iw, info )
225  CALL chkxer( 'SGESVXX', infot, nout, lerr, ok )
226  infot = 4
227  CALL sgesvxx( 'N', 'N', 0, -1, a, 1, af, 1, ip, eq, r, c, b, 1,
228  $ x, 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
229  $ err_bnds_c, nparams, params, w, iw, info )
230  CALL chkxer( 'SGESVXX', infot, nout, lerr, ok )
231  infot = 6
232  CALL sgesvxx( 'N', 'N', 2, 1, a, 1, af, 2, ip, eq, r, c, b, 2,
233  $ x, 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
234  $ err_bnds_c, nparams, params, w, iw, info )
235  CALL chkxer( 'SGESVXX', infot, nout, lerr, ok )
236  infot = 8
237  CALL sgesvxx( 'N', 'N', 2, 1, a, 2, af, 1, ip, eq, r, c, b, 2,
238  $ x, 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
239  $ err_bnds_c, nparams, params, w, iw, info )
240  CALL chkxer( 'SGESVXX', infot, nout, lerr, ok )
241  infot = 10
242  eq = '/'
243  CALL sgesvxx( 'F', 'N', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
244  $ x, 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
245  $ err_bnds_c, nparams, params, w, iw, info )
246  CALL chkxer( 'SGESVXX', infot, nout, lerr, ok )
247  infot = 11
248  eq = 'R'
249  CALL sgesvxx( 'F', 'N', 1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
250  $ x, 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
251  $ err_bnds_c, nparams, params, w, iw, info )
252  CALL chkxer( 'SGESVXX', infot, nout, lerr, ok )
253  infot = 12
254  eq = 'C'
255  CALL sgesvxx( 'F', 'N', 1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
256  $ x, 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
257  $ err_bnds_c, nparams, params, w, iw, info )
258  CALL chkxer( 'SGESVXX', infot, nout, lerr, ok )
259  infot = 14
260  CALL sgesvxx( 'N', 'N', 2, 1, a, 2, af, 2, ip, eq, r, c, b, 1,
261  $ x, 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
262  $ err_bnds_c, nparams, params, w, iw, info )
263  CALL chkxer( 'SGESVXX', infot, nout, lerr, ok )
264  infot = 16
265  CALL sgesvxx( 'N', 'N', 2, 1, a, 2, af, 2, ip, eq, r, c, b, 2,
266  $ x, 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
267  $ err_bnds_c, nparams, params, w, iw, info )
268  CALL chkxer( 'SGESVXX', infot, nout, lerr, ok )
269 *
270  ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
271 *
272 * SGBSV
273 *
274  srnamt = 'SGBSV '
275  infot = 1
276  CALL sgbsv( -1, 0, 0, 0, a, 1, ip, b, 1, info )
277  CALL chkxer( 'SGBSV ', infot, nout, lerr, ok )
278  infot = 2
279  CALL sgbsv( 1, -1, 0, 0, a, 1, ip, b, 1, info )
280  CALL chkxer( 'SGBSV ', infot, nout, lerr, ok )
281  infot = 3
282  CALL sgbsv( 1, 0, -1, 0, a, 1, ip, b, 1, info )
283  CALL chkxer( 'SGBSV ', infot, nout, lerr, ok )
284  infot = 4
285  CALL sgbsv( 0, 0, 0, -1, a, 1, ip, b, 1, info )
286  CALL chkxer( 'SGBSV ', infot, nout, lerr, ok )
287  infot = 6
288  CALL sgbsv( 1, 1, 1, 0, a, 3, ip, b, 1, info )
289  CALL chkxer( 'SGBSV ', infot, nout, lerr, ok )
290  infot = 9
291  CALL sgbsv( 2, 0, 0, 0, a, 1, ip, b, 1, info )
292  CALL chkxer( 'SGBSV ', infot, nout, lerr, ok )
293 *
294 * SGBSVX
295 *
296  srnamt = 'SGBSVX'
297  infot = 1
298  CALL sgbsvx( '/', 'N', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
299  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
300  CALL chkxer( 'SGBSVX', infot, nout, lerr, ok )
301  infot = 2
302  CALL sgbsvx( 'N', '/', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
303  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
304  CALL chkxer( 'SGBSVX', infot, nout, lerr, ok )
305  infot = 3
306  CALL sgbsvx( 'N', 'N', -1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
307  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
308  CALL chkxer( 'SGBSVX', infot, nout, lerr, ok )
309  infot = 4
310  CALL sgbsvx( 'N', 'N', 1, -1, 0, 0, a, 1, af, 1, ip, eq, r, c,
311  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
312  CALL chkxer( 'SGBSVX', infot, nout, lerr, ok )
313  infot = 5
314  CALL sgbsvx( 'N', 'N', 1, 0, -1, 0, a, 1, af, 1, ip, eq, r, c,
315  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
316  CALL chkxer( 'SGBSVX', infot, nout, lerr, ok )
317  infot = 6
318  CALL sgbsvx( 'N', 'N', 0, 0, 0, -1, a, 1, af, 1, ip, eq, r, c,
319  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
320  CALL chkxer( 'SGBSVX', infot, nout, lerr, ok )
321  infot = 8
322  CALL sgbsvx( 'N', 'N', 1, 1, 1, 0, a, 2, af, 4, ip, eq, r, c,
323  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
324  CALL chkxer( 'SGBSVX', infot, nout, lerr, ok )
325  infot = 10
326  CALL sgbsvx( 'N', 'N', 1, 1, 1, 0, a, 3, af, 3, ip, eq, r, c,
327  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
328  CALL chkxer( 'SGBSVX', infot, nout, lerr, ok )
329  infot = 12
330  eq = '/'
331  CALL sgbsvx( 'F', 'N', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
332  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
333  CALL chkxer( 'SGBSVX', infot, nout, lerr, ok )
334  infot = 13
335  eq = 'R'
336  CALL sgbsvx( 'F', 'N', 1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
337  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
338  CALL chkxer( 'SGBSVX', infot, nout, lerr, ok )
339  infot = 14
340  eq = 'C'
341  CALL sgbsvx( 'F', 'N', 1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
342  $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
343  CALL chkxer( 'SGBSVX', infot, nout, lerr, ok )
344  infot = 16
345  CALL sgbsvx( 'N', 'N', 2, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
346  $ b, 1, x, 2, rcond, r1, r2, w, iw, info )
347  CALL chkxer( 'SGBSVX', infot, nout, lerr, ok )
348  infot = 18
349  CALL sgbsvx( 'N', 'N', 2, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
350  $ b, 2, x, 1, rcond, r1, r2, w, iw, info )
351  CALL chkxer( 'SGBSVX', infot, nout, lerr, ok )
352 *
353 * SGBSVXX
354 *
355  n_err_bnds = 3
356  nparams = 1
357  srnamt = 'SGBSVXX'
358  infot = 1
359  CALL sgbsvxx( '/', 'N', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
360  $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
361  $ err_bnds_n, err_bnds_c, nparams, params, w, iw,
362  $ info )
363  CALL chkxer( 'SGBSVXX', infot, nout, lerr, ok )
364  infot = 2
365  CALL sgbsvxx( 'N', '/', 0, 1, 1, 0, a, 1, af, 1, ip, eq, r, c,
366  $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
367  $ err_bnds_n, err_bnds_c, nparams, params, w, iw,
368  $ info )
369  CALL chkxer( 'SGBSVXX', infot, nout, lerr, ok )
370  infot = 3
371  CALL sgbsvxx( 'N', 'N', -1, 1, 1, 0, a, 1, af, 1, ip, eq, r, c,
372  $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
373  $ err_bnds_n, err_bnds_c, nparams, params, w, iw,
374  $ info )
375  CALL chkxer( 'SGBSVXX', infot, nout, lerr, ok )
376  infot = 4
377  CALL sgbsvxx( 'N', 'N', 2, -1, 1, 0, a, 1, af, 1, ip, eq,
378  $ r, c, b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
379  $ err_bnds_n, err_bnds_c, nparams, params, w, iw,
380  $ info )
381  CALL chkxer( 'SGBSVXX', infot, nout, lerr, ok )
382  infot = 5
383  CALL sgbsvxx( 'N', 'N', 2, 1, -1, 0, a, 1, af, 1, ip, eq,
384  $ r, c, b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
385  $ err_bnds_n, err_bnds_c, nparams, params, w, iw,
386  $ info )
387  CALL chkxer( 'SGBSVXX', infot, nout, lerr, ok )
388  infot = 6
389  CALL sgbsvxx( 'N', 'N', 0, 1, 1, -1, a, 1, af, 1, ip, eq, r, c,
390  $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
391  $ err_bnds_n, err_bnds_c, nparams, params, w, iw,
392  $ info )
393  CALL chkxer( 'SGBSVXX', infot, nout, lerr, ok )
394  infot = 8
395  CALL sgbsvxx( 'N', 'N', 2, 1, 1, 1, a, 2, af, 2, ip, eq, r, c,
396  $ b, 2, x, 2, rcond, rpvgrw, berr, n_err_bnds,
397  $ err_bnds_n, err_bnds_c, nparams, params, w, iw,
398  $ info )
399  CALL chkxer( 'SGBSVXX', infot, nout, lerr, ok )
400  infot = 10
401  CALL sgbsvxx( 'N', 'N', 2, 1, 1, 1, a, 3, af, 3, ip, eq, r, c,
402  $ b, 2, x, 2, rcond, rpvgrw, berr, n_err_bnds,
403  $ err_bnds_n, err_bnds_c, nparams, params, w, iw,
404  $ info )
405  CALL chkxer( 'SGBSVXX', infot, nout, lerr, ok )
406  infot = 12
407  eq = '/'
408  CALL sgbsvxx( 'F', 'N', 0, 1, 1, 0, a, 3, af, 4, ip, eq, r, c,
409  $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
410  $ err_bnds_n, err_bnds_c, nparams, params, w, iw,
411  $ info )
412  CALL chkxer( 'SGBSVXX', infot, nout, lerr, ok )
413  infot = 13
414  eq = 'R'
415  CALL sgbsvxx( 'F', 'N', 1, 1, 1, 0, a, 3, af, 4, ip, eq, r, c,
416  $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
417  $ err_bnds_n, err_bnds_c, nparams, params, w, iw,
418  $ info )
419  CALL chkxer( 'SGBSVXX', infot, nout, lerr, ok )
420  infot = 14
421  eq = 'C'
422  CALL sgbsvxx( 'F', 'N', 1, 1, 1, 0, a, 3, af, 4, ip, eq, r, c,
423  $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
424  $ err_bnds_n, err_bnds_c, nparams, params, w, iw,
425  $ info )
426  CALL chkxer( 'SGBSVXX', infot, nout, lerr, ok )
427  infot = 15
428  CALL sgbsvxx( 'N', 'N', 2, 1, 1, 1, a, 3, af, 4, ip, eq, r, c,
429  $ b, 1, x, 2, rcond, rpvgrw, berr, n_err_bnds,
430  $ err_bnds_n, err_bnds_c, nparams, params, w, iw,
431  $ info )
432  CALL chkxer( 'SGBSVXX', infot, nout, lerr, ok )
433  infot = 16
434  CALL sgbsvxx( 'N', 'N', 2, 1, 1, 1, a, 3, af, 4, ip, eq, r, c,
435  $ b, 2, x, 1, rcond, rpvgrw, berr, n_err_bnds,
436  $ err_bnds_n, err_bnds_c, nparams, params, w, iw,
437  $ info )
438  CALL chkxer( 'SGBSVXX', infot, nout, lerr, ok )
439 *
440  ELSE IF( lsamen( 2, c2, 'GT' ) ) THEN
441 *
442 * SGTSV
443 *
444  srnamt = 'SGTSV '
445  infot = 1
446  CALL sgtsv( -1, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1,
447  $ info )
448  CALL chkxer( 'SGTSV ', infot, nout, lerr, ok )
449  infot = 2
450  CALL sgtsv( 0, -1, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1,
451  $ info )
452  CALL chkxer( 'SGTSV ', infot, nout, lerr, ok )
453  infot = 7
454  CALL sgtsv( 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1, info )
455  CALL chkxer( 'SGTSV ', infot, nout, lerr, ok )
456 *
457 * SGTSVX
458 *
459  srnamt = 'SGTSVX'
460  infot = 1
461  CALL sgtsvx( '/', 'N', 0, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
462  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
463  $ ip, b, 1, x, 1, rcond, r1, r2, w, iw, info )
464  CALL chkxer( 'SGTSVX', infot, nout, lerr, ok )
465  infot = 2
466  CALL sgtsvx( 'N', '/', 0, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
467  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
468  $ ip, b, 1, x, 1, rcond, r1, r2, w, iw, info )
469  CALL chkxer( 'SGTSVX', infot, nout, lerr, ok )
470  infot = 3
471  CALL sgtsvx( 'N', 'N', -1, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
472  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
473  $ ip, b, 1, x, 1, rcond, r1, r2, w, iw, info )
474  CALL chkxer( 'SGTSVX', infot, nout, lerr, ok )
475  infot = 4
476  CALL sgtsvx( 'N', 'N', 0, -1, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
477  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
478  $ ip, b, 1, x, 1, rcond, r1, r2, w, iw, info )
479  CALL chkxer( 'SGTSVX', infot, nout, lerr, ok )
480  infot = 14
481  CALL sgtsvx( 'N', 'N', 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
482  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
483  $ ip, b, 1, x, 2, rcond, r1, r2, w, iw, info )
484  CALL chkxer( 'SGTSVX', infot, nout, lerr, ok )
485  infot = 16
486  CALL sgtsvx( 'N', 'N', 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
487  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
488  $ ip, b, 2, x, 1, rcond, r1, r2, w, iw, info )
489  CALL chkxer( 'SGTSVX', infot, nout, lerr, ok )
490 *
491  ELSE IF( lsamen( 2, c2, 'PO' ) ) THEN
492 *
493 * SPOSV
494 *
495  srnamt = 'SPOSV '
496  infot = 1
497  CALL sposv( '/', 0, 0, a, 1, b, 1, info )
498  CALL chkxer( 'SPOSV ', infot, nout, lerr, ok )
499  infot = 2
500  CALL sposv( 'U', -1, 0, a, 1, b, 1, info )
501  CALL chkxer( 'SPOSV ', infot, nout, lerr, ok )
502  infot = 3
503  CALL sposv( 'U', 0, -1, a, 1, b, 1, info )
504  CALL chkxer( 'SPOSV ', infot, nout, lerr, ok )
505  infot = 5
506  CALL sposv( 'U', 2, 0, a, 1, b, 2, info )
507  CALL chkxer( 'SPOSV ', infot, nout, lerr, ok )
508  infot = 7
509  CALL sposv( 'U', 2, 0, a, 2, b, 1, info )
510  CALL chkxer( 'SPOSV ', infot, nout, lerr, ok )
511 *
512 * SPOSVX
513 *
514  srnamt = 'SPOSVX'
515  infot = 1
516  CALL sposvx( '/', 'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
517  $ rcond, r1, r2, w, iw, info )
518  CALL chkxer( 'SPOSVX', infot, nout, lerr, ok )
519  infot = 2
520  CALL sposvx( 'N', '/', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
521  $ rcond, r1, r2, w, iw, info )
522  CALL chkxer( 'SPOSVX', infot, nout, lerr, ok )
523  infot = 3
524  CALL sposvx( 'N', 'U', -1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
525  $ rcond, r1, r2, w, iw, info )
526  CALL chkxer( 'SPOSVX', infot, nout, lerr, ok )
527  infot = 4
528  CALL sposvx( 'N', 'U', 0, -1, a, 1, af, 1, eq, c, b, 1, x, 1,
529  $ rcond, r1, r2, w, iw, info )
530  CALL chkxer( 'SPOSVX', infot, nout, lerr, ok )
531  infot = 6
532  CALL sposvx( 'N', 'U', 2, 0, a, 1, af, 2, eq, c, b, 2, x, 2,
533  $ rcond, r1, r2, w, iw, info )
534  CALL chkxer( 'SPOSVX', infot, nout, lerr, ok )
535  infot = 8
536  CALL sposvx( 'N', 'U', 2, 0, a, 2, af, 1, eq, c, b, 2, x, 2,
537  $ rcond, r1, r2, w, iw, info )
538  CALL chkxer( 'SPOSVX', infot, nout, lerr, ok )
539  infot = 9
540  eq = '/'
541  CALL sposvx( 'F', 'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
542  $ rcond, r1, r2, w, iw, info )
543  CALL chkxer( 'SPOSVX', infot, nout, lerr, ok )
544  infot = 10
545  eq = 'Y'
546  CALL sposvx( 'F', 'U', 1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
547  $ rcond, r1, r2, w, iw, info )
548  CALL chkxer( 'SPOSVX', infot, nout, lerr, ok )
549  infot = 12
550  CALL sposvx( 'N', 'U', 2, 0, a, 2, af, 2, eq, c, b, 1, x, 2,
551  $ rcond, r1, r2, w, iw, info )
552  CALL chkxer( 'SPOSVX', infot, nout, lerr, ok )
553  infot = 14
554  CALL sposvx( 'N', 'U', 2, 0, a, 2, af, 2, eq, c, b, 2, x, 1,
555  $ rcond, r1, r2, w, iw, info )
556  CALL chkxer( 'SPOSVX', infot, nout, lerr, ok )
557 *
558 * SPOSVXX
559 *
560  n_err_bnds = 3
561  nparams = 1
562  srnamt = 'SPOSVXX'
563  infot = 1
564  CALL sposvxx( '/', 'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
565  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
566  $ err_bnds_c, nparams, params, w, iw, info )
567  CALL chkxer( 'SPOSVXX', infot, nout, lerr, ok )
568  infot = 2
569  CALL sposvxx( 'N', '/', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
570  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
571  $ err_bnds_c, nparams, params, w, iw, info )
572  CALL chkxer( 'SPOSVXX', infot, nout, lerr, ok )
573  infot = 3
574  CALL sposvxx( 'N', 'U', -1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
575  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
576  $ err_bnds_c, nparams, params, w, iw, info )
577  CALL chkxer( 'SPOSVXX', infot, nout, lerr, ok )
578  infot = 4
579  CALL sposvxx( 'N', 'U', 0, -1, a, 1, af, 1, eq, c, b, 1, x, 1,
580  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
581  $ err_bnds_c, nparams, params, w, iw, info )
582  CALL chkxer( 'SPOSVXX', infot, nout, lerr, ok )
583  infot = 6
584  CALL sposvxx( 'N', 'U', 2, 0, a, 1, af, 2, eq, c, b, 2, x, 2,
585  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
586  $ err_bnds_c, nparams, params, w, iw, info )
587  CALL chkxer( 'SPOSVXX', infot, nout, lerr, ok )
588  infot = 8
589  CALL sposvxx( 'N', 'U', 2, 0, a, 2, af, 1, eq, c, b, 2, x, 2,
590  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
591  $ err_bnds_c, nparams, params, w, iw, info )
592  CALL chkxer( 'SPOSVXX', infot, nout, lerr, ok )
593  infot = 9
594  eq = '/'
595  CALL sposvxx( 'F', 'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
596  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
597  $ err_bnds_c, nparams, params, w, iw, info )
598  CALL chkxer( 'SPOSVXX', infot, nout, lerr, ok )
599  infot = 10
600  eq = 'Y'
601  CALL sposvxx( 'F', 'U', 1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
602  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
603  $ err_bnds_c, nparams, params, w, iw, info )
604  CALL chkxer( 'SPOSVXX', infot, nout, lerr, ok )
605  infot = 12
606  CALL sposvxx( 'N', 'U', 2, 0, a, 2, af, 2, eq, c, b, 1, x, 2,
607  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
608  $ err_bnds_c, nparams, params, w, iw, info )
609  CALL chkxer( 'SPOSVXX', infot, nout, lerr, ok )
610  infot = 14
611  CALL sposvxx( 'N', 'U', 2, 0, a, 2, af, 2, eq, c, b, 2, x, 1,
612  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
613  $ err_bnds_c, nparams, params, w, iw, info )
614  CALL chkxer( 'SPOSVXX', infot, nout, lerr, ok )
615 *
616  ELSE IF( lsamen( 2, c2, 'PP' ) ) THEN
617 *
618 * SPPSV
619 *
620  srnamt = 'SPPSV '
621  infot = 1
622  CALL sppsv( '/', 0, 0, a, b, 1, info )
623  CALL chkxer( 'SPPSV ', infot, nout, lerr, ok )
624  infot = 2
625  CALL sppsv( 'U', -1, 0, a, b, 1, info )
626  CALL chkxer( 'SPPSV ', infot, nout, lerr, ok )
627  infot = 3
628  CALL sppsv( 'U', 0, -1, a, b, 1, info )
629  CALL chkxer( 'SPPSV ', infot, nout, lerr, ok )
630  infot = 6
631  CALL sppsv( 'U', 2, 0, a, b, 1, info )
632  CALL chkxer( 'SPPSV ', infot, nout, lerr, ok )
633 *
634 * SPPSVX
635 *
636  srnamt = 'SPPSVX'
637  infot = 1
638  CALL sppsvx( '/', 'U', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
639  $ r1, r2, w, iw, info )
640  CALL chkxer( 'SPPSVX', infot, nout, lerr, ok )
641  infot = 2
642  CALL sppsvx( 'N', '/', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
643  $ r1, r2, w, iw, info )
644  CALL chkxer( 'SPPSVX', infot, nout, lerr, ok )
645  infot = 3
646  CALL sppsvx( 'N', 'U', -1, 0, a, af, eq, c, b, 1, x, 1, rcond,
647  $ r1, r2, w, iw, info )
648  CALL chkxer( 'SPPSVX', infot, nout, lerr, ok )
649  infot = 4
650  CALL sppsvx( 'N', 'U', 0, -1, a, af, eq, c, b, 1, x, 1, rcond,
651  $ r1, r2, w, iw, info )
652  CALL chkxer( 'SPPSVX', infot, nout, lerr, ok )
653  infot = 7
654  eq = '/'
655  CALL sppsvx( 'F', 'U', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
656  $ r1, r2, w, iw, info )
657  CALL chkxer( 'SPPSVX', infot, nout, lerr, ok )
658  infot = 8
659  eq = 'Y'
660  CALL sppsvx( 'F', 'U', 1, 0, a, af, eq, c, b, 1, x, 1, rcond,
661  $ r1, r2, w, iw, info )
662  CALL chkxer( 'SPPSVX', infot, nout, lerr, ok )
663  infot = 10
664  CALL sppsvx( 'N', 'U', 2, 0, a, af, eq, c, b, 1, x, 2, rcond,
665  $ r1, r2, w, iw, info )
666  CALL chkxer( 'SPPSVX', infot, nout, lerr, ok )
667  infot = 12
668  CALL sppsvx( 'N', 'U', 2, 0, a, af, eq, c, b, 2, x, 1, rcond,
669  $ r1, r2, w, iw, info )
670  CALL chkxer( 'SPPSVX', infot, nout, lerr, ok )
671 *
672  ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
673 *
674 * SPBSV
675 *
676  srnamt = 'SPBSV '
677  infot = 1
678  CALL spbsv( '/', 0, 0, 0, a, 1, b, 1, info )
679  CALL chkxer( 'SPBSV ', infot, nout, lerr, ok )
680  infot = 2
681  CALL spbsv( 'U', -1, 0, 0, a, 1, b, 1, info )
682  CALL chkxer( 'SPBSV ', infot, nout, lerr, ok )
683  infot = 3
684  CALL spbsv( 'U', 1, -1, 0, a, 1, b, 1, info )
685  CALL chkxer( 'SPBSV ', infot, nout, lerr, ok )
686  infot = 4
687  CALL spbsv( 'U', 0, 0, -1, a, 1, b, 1, info )
688  CALL chkxer( 'SPBSV ', infot, nout, lerr, ok )
689  infot = 6
690  CALL spbsv( 'U', 1, 1, 0, a, 1, b, 2, info )
691  CALL chkxer( 'SPBSV ', infot, nout, lerr, ok )
692  infot = 8
693  CALL spbsv( 'U', 2, 0, 0, a, 1, b, 1, info )
694  CALL chkxer( 'SPBSV ', infot, nout, lerr, ok )
695 *
696 * SPBSVX
697 *
698  srnamt = 'SPBSVX'
699  infot = 1
700  CALL spbsvx( '/', 'U', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
701  $ rcond, r1, r2, w, iw, info )
702  CALL chkxer( 'SPBSVX', infot, nout, lerr, ok )
703  infot = 2
704  CALL spbsvx( 'N', '/', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
705  $ rcond, r1, r2, w, iw, info )
706  CALL chkxer( 'SPBSVX', infot, nout, lerr, ok )
707  infot = 3
708  CALL spbsvx( 'N', 'U', -1, 0, 0, a, 1, af, 1, eq, c, b, 1, x,
709  $ 1, rcond, r1, r2, w, iw, info )
710  CALL chkxer( 'SPBSVX', infot, nout, lerr, ok )
711  infot = 4
712  CALL spbsvx( 'N', 'U', 1, -1, 0, a, 1, af, 1, eq, c, b, 1, x,
713  $ 1, rcond, r1, r2, w, iw, info )
714  CALL chkxer( 'SPBSVX', infot, nout, lerr, ok )
715  infot = 5
716  CALL spbsvx( 'N', 'U', 0, 0, -1, a, 1, af, 1, eq, c, b, 1, x,
717  $ 1, rcond, r1, r2, w, iw, info )
718  CALL chkxer( 'SPBSVX', infot, nout, lerr, ok )
719  infot = 7
720  CALL spbsvx( 'N', 'U', 1, 1, 0, a, 1, af, 2, eq, c, b, 2, x, 2,
721  $ rcond, r1, r2, w, iw, info )
722  CALL chkxer( 'SPBSVX', infot, nout, lerr, ok )
723  infot = 9
724  CALL spbsvx( 'N', 'U', 1, 1, 0, a, 2, af, 1, eq, c, b, 2, x, 2,
725  $ rcond, r1, r2, w, iw, info )
726  CALL chkxer( 'SPBSVX', infot, nout, lerr, ok )
727  infot = 10
728  eq = '/'
729  CALL spbsvx( 'F', 'U', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
730  $ rcond, r1, r2, w, iw, info )
731  CALL chkxer( 'SPBSVX', infot, nout, lerr, ok )
732  infot = 11
733  eq = 'Y'
734  CALL spbsvx( 'F', 'U', 1, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
735  $ rcond, r1, r2, w, iw, info )
736  CALL chkxer( 'SPBSVX', infot, nout, lerr, ok )
737  infot = 13
738  CALL spbsvx( 'N', 'U', 2, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 2,
739  $ rcond, r1, r2, w, iw, info )
740  CALL chkxer( 'SPBSVX', infot, nout, lerr, ok )
741  infot = 15
742  CALL spbsvx( 'N', 'U', 2, 0, 0, a, 1, af, 1, eq, c, b, 2, x, 1,
743  $ rcond, r1, r2, w, iw, info )
744  CALL chkxer( 'SPBSVX', infot, nout, lerr, ok )
745 *
746  ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
747 *
748 * SPTSV
749 *
750  srnamt = 'SPTSV '
751  infot = 1
752  CALL sptsv( -1, 0, a( 1, 1 ), a( 1, 2 ), b, 1, info )
753  CALL chkxer( 'SPTSV ', infot, nout, lerr, ok )
754  infot = 2
755  CALL sptsv( 0, -1, a( 1, 1 ), a( 1, 2 ), b, 1, info )
756  CALL chkxer( 'SPTSV ', infot, nout, lerr, ok )
757  infot = 6
758  CALL sptsv( 2, 0, a( 1, 1 ), a( 1, 2 ), b, 1, info )
759  CALL chkxer( 'SPTSV ', infot, nout, lerr, ok )
760 *
761 * SPTSVX
762 *
763  srnamt = 'SPTSVX'
764  infot = 1
765  CALL sptsvx( '/', 0, 0, a( 1, 1 ), a( 1, 2 ), af( 1, 1 ),
766  $ af( 1, 2 ), b, 1, x, 1, rcond, r1, r2, w, info )
767  CALL chkxer( 'SPTSVX', infot, nout, lerr, ok )
768  infot = 2
769  CALL sptsvx( 'N', -1, 0, a( 1, 1 ), a( 1, 2 ), af( 1, 1 ),
770  $ af( 1, 2 ), b, 1, x, 1, rcond, r1, r2, w, info )
771  CALL chkxer( 'SPTSVX', infot, nout, lerr, ok )
772  infot = 3
773  CALL sptsvx( 'N', 0, -1, a( 1, 1 ), a( 1, 2 ), af( 1, 1 ),
774  $ af( 1, 2 ), b, 1, x, 1, rcond, r1, r2, w, info )
775  CALL chkxer( 'SPTSVX', infot, nout, lerr, ok )
776  infot = 9
777  CALL sptsvx( 'N', 2, 0, a( 1, 1 ), a( 1, 2 ), af( 1, 1 ),
778  $ af( 1, 2 ), b, 1, x, 2, rcond, r1, r2, w, info )
779  CALL chkxer( 'SPTSVX', infot, nout, lerr, ok )
780  infot = 11
781  CALL sptsvx( 'N', 2, 0, a( 1, 1 ), a( 1, 2 ), af( 1, 1 ),
782  $ af( 1, 2 ), b, 2, x, 1, rcond, r1, r2, w, info )
783  CALL chkxer( 'SPTSVX', infot, nout, lerr, ok )
784 *
785  ELSE IF( lsamen( 2, c2, 'SY' ) ) THEN
786 *
787 * SSYSV
788 *
789  srnamt = 'SSYSV '
790  infot = 1
791  CALL ssysv( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
792  CALL chkxer( 'SSYSV ', infot, nout, lerr, ok )
793  infot = 2
794  CALL ssysv( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
795  CALL chkxer( 'SSYSV ', infot, nout, lerr, ok )
796  infot = 3
797  CALL ssysv( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
798  CALL chkxer( 'SSYSV ', infot, nout, lerr, ok )
799  infot = 8
800  CALL ssysv( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
801  CALL chkxer( 'SSYSV ', infot, nout, lerr, ok )
802 *
803 * SSYSVX
804 *
805  srnamt = 'SSYSVX'
806  infot = 1
807  CALL ssysvx( '/', 'U', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
808  $ rcond, r1, r2, w, 1, iw, info )
809  CALL chkxer( 'SSYSVX', infot, nout, lerr, ok )
810  infot = 2
811  CALL ssysvx( 'N', '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
812  $ rcond, r1, r2, w, 1, iw, info )
813  CALL chkxer( 'SSYSVX', infot, nout, lerr, ok )
814  infot = 3
815  CALL ssysvx( 'N', 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1,
816  $ rcond, r1, r2, w, 1, iw, info )
817  CALL chkxer( 'SSYSVX', infot, nout, lerr, ok )
818  infot = 4
819  CALL ssysvx( 'N', 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1,
820  $ rcond, r1, r2, w, 1, iw, info )
821  CALL chkxer( 'SSYSVX', infot, nout, lerr, ok )
822  infot = 6
823  CALL ssysvx( 'N', 'U', 2, 0, a, 1, af, 2, ip, b, 2, x, 2,
824  $ rcond, r1, r2, w, 4, iw, info )
825  CALL chkxer( 'SSYSVX', infot, nout, lerr, ok )
826  infot = 8
827  CALL ssysvx( 'N', 'U', 2, 0, a, 2, af, 1, ip, b, 2, x, 2,
828  $ rcond, r1, r2, w, 4, iw, info )
829  CALL chkxer( 'SSYSVX', infot, nout, lerr, ok )
830  infot = 11
831  CALL ssysvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 1, x, 2,
832  $ rcond, r1, r2, w, 4, iw, info )
833  CALL chkxer( 'SSYSVX', infot, nout, lerr, ok )
834  infot = 13
835  CALL ssysvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 1,
836  $ rcond, r1, r2, w, 4, iw, info )
837  CALL chkxer( 'SSYSVX', infot, nout, lerr, ok )
838  infot = 18
839  CALL ssysvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 2,
840  $ rcond, r1, r2, w, 3, iw, info )
841  CALL chkxer( 'SSYSVX', infot, nout, lerr, ok )
842 *
843 * SSYSVXX
844 *
845  n_err_bnds = 3
846  nparams = 1
847  srnamt = 'SSYSVXX'
848  infot = 1
849  eq = 'N'
850  CALL ssysvxx( '/', 'U', 0, 0, a, 1, af, 1, ip, eq, r, b, 1, x,
851  $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
852  $ err_bnds_c, nparams, params, w, iw, info )
853  CALL chkxer( 'SSYSVXX', infot, nout, lerr, ok )
854  infot = 2
855  CALL ssysvxx( 'N', '/', 0, 0, a, 1, af, 1, ip, eq, r, b, 1, x,
856  $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
857  $ err_bnds_c, nparams, params, w, iw, info )
858  CALL chkxer( 'SSYSVXX', infot, nout, lerr, ok )
859  infot = 3
860  CALL ssysvxx( 'N', 'U', -1, 0, a, 1, af, 1, ip, eq, r, b, 1, x,
861  $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
862  $ err_bnds_c, nparams, params, w, iw, info )
863  CALL chkxer( 'SSYSVXX', infot, nout, lerr, ok )
864  infot = 4
865  eq = '/'
866  CALL ssysvxx( 'N', 'U', 0, -1, a, 1, af, 1, ip, eq, r, b, 1, x,
867  $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
868  $ err_bnds_c, nparams, params, w, iw, info )
869  CALL chkxer( 'SSYSVXX', infot, nout, lerr, ok )
870  eq = 'Y'
871  infot = 6
872  CALL ssysvxx( 'N', 'U', 2, 0, a, 1, af, 2, ip, eq, r, b, 2, x,
873  $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
874  $ err_bnds_c, nparams, params, w, iw, info )
875  CALL chkxer( 'SSYSVXX', infot, nout, lerr, ok )
876  infot = 8
877  CALL ssysvxx( 'N', 'U', 2, 0, a, 2, af, 1, ip, eq, r, b, 2, x,
878  $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
879  $ err_bnds_c, nparams, params, w, iw, info )
880  CALL chkxer( 'SSYSVXX', infot, nout, lerr, ok )
881  infot = 10
882  CALL ssysvxx( 'F', 'U', 2, 0, a, 2, af, 2, ip, 'A', r, b, 2, x,
883  $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
884  $ err_bnds_c, nparams, params, w, iw, info )
885  CALL chkxer( 'SSYSVXX', infot, nout, lerr, ok )
886  infot = 11
887  eq='Y'
888  CALL ssysvxx( 'F', 'U', 2, 0, a, 2, af, 2, ip, eq, r, b, 2, x,
889  $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
890  $ err_bnds_c, nparams, params, w, iw, info )
891  CALL chkxer( 'SSYSVXX', infot, nout, lerr, ok )
892  infot = 11
893  eq='Y'
894  r(1) = -one
895  CALL ssysvxx( 'F', 'U', 2, 0, a, 2, af, 2, ip, eq, r, b, 2, x,
896  $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
897  $ err_bnds_c, nparams, params, w, iw, info )
898  CALL chkxer( 'SSYSVXX', infot, nout, lerr, ok )
899  infot = 13
900  eq = 'N'
901  CALL ssysvxx( 'N', 'U', 2, 0, a, 2, af, 2, ip, eq, r, b, 1, x,
902  $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
903  $ err_bnds_c, nparams, params, w, iw, info )
904  CALL chkxer( 'SSYSVXX', infot, nout, lerr, ok )
905  infot = 15
906  CALL ssysvxx( 'N', 'U', 2, 0, a, 2, af, 2, ip, eq, r, b, 2, x,
907  $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
908  $ err_bnds_c, nparams, params, w, iw, info )
909  CALL chkxer( 'SSYSVXX', infot, nout, lerr, ok )
910 *
911 * SSYSV_ROOK
912 *
913  srnamt = 'SSYSV_ROOK'
914  infot = 1
915  CALL ssysv_rook( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
916  CALL chkxer( 'SSYSV_ROOK', infot, nout, lerr, ok )
917  infot = 2
918  CALL ssysv_rook( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
919  CALL chkxer( 'SSYSV_ROOK', infot, nout, lerr, ok )
920  infot = 3
921  CALL ssysv_rook( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
922  CALL chkxer( 'SSYSV_ROOK', infot, nout, lerr, ok )
923  infot = 8
924  CALL ssysv_rook( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
925  CALL chkxer( 'SSYSV_ROOK', infot, nout, lerr, ok )
926 *
927  ELSE IF( lsamen( 2, c2, 'SP' ) ) THEN
928 *
929 * SSPSV
930 *
931  srnamt = 'SSPSV '
932  infot = 1
933  CALL sspsv( '/', 0, 0, a, ip, b, 1, info )
934  CALL chkxer( 'SSPSV ', infot, nout, lerr, ok )
935  infot = 2
936  CALL sspsv( 'U', -1, 0, a, ip, b, 1, info )
937  CALL chkxer( 'SSPSV ', infot, nout, lerr, ok )
938  infot = 3
939  CALL sspsv( 'U', 0, -1, a, ip, b, 1, info )
940  CALL chkxer( 'SSPSV ', infot, nout, lerr, ok )
941  infot = 7
942  CALL sspsv( 'U', 2, 0, a, ip, b, 1, info )
943  CALL chkxer( 'SSPSV ', infot, nout, lerr, ok )
944 *
945 * SSPSVX
946 *
947  srnamt = 'SSPSVX'
948  infot = 1
949  CALL sspsvx( '/', 'U', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
950  $ r2, w, iw, info )
951  CALL chkxer( 'SSPSVX', infot, nout, lerr, ok )
952  infot = 2
953  CALL sspsvx( 'N', '/', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
954  $ r2, w, iw, info )
955  CALL chkxer( 'SSPSVX', infot, nout, lerr, ok )
956  infot = 3
957  CALL sspsvx( 'N', 'U', -1, 0, a, af, ip, b, 1, x, 1, rcond, r1,
958  $ r2, w, iw, info )
959  CALL chkxer( 'SSPSVX', infot, nout, lerr, ok )
960  infot = 4
961  CALL sspsvx( 'N', 'U', 0, -1, a, af, ip, b, 1, x, 1, rcond, r1,
962  $ r2, w, iw, info )
963  CALL chkxer( 'SSPSVX', infot, nout, lerr, ok )
964  infot = 9
965  CALL sspsvx( 'N', 'U', 2, 0, a, af, ip, b, 1, x, 2, rcond, r1,
966  $ r2, w, iw, info )
967  CALL chkxer( 'SSPSVX', infot, nout, lerr, ok )
968  infot = 11
969  CALL sspsvx( 'N', 'U', 2, 0, a, af, ip, b, 2, x, 1, rcond, r1,
970  $ r2, w, iw, info )
971  CALL chkxer( 'SSPSVX', infot, nout, lerr, ok )
972  END IF
973 *
974 * Print a summary line.
975 *
976  IF( ok ) THEN
977  WRITE( nout, fmt = 9999 )path
978  ELSE
979  WRITE( nout, fmt = 9998 )path
980  END IF
981 *
982  9999 FORMAT( 1x, a3, ' drivers passed the tests of the error exits' )
983  9998 FORMAT( ' *** ', a3, ' drivers failed the tests of the error ',
984  $ 'exits ***' )
985 *
986  RETURN
987 *
988 * End of SERRVX
989 *
990  END
subroutine sposvxx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO)
SPOSVXX computes the solution to system of linear equations A * X = B for PO matrices ...
Definition: sposvxx.f:499
subroutine ssysvxx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO)
SSYSVXX
Definition: ssysvxx.f:510
subroutine sgesv(N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SGESV computes the solution to system of linear equations A * X = B for GE matrices (simple driver) ...
Definition: sgesv.f:124
subroutine sgbsv(N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
SGBSV computes the solution to system of linear equations A * X = B for GB matrices (simple driver) ...
Definition: sgbsv.f:164
subroutine sgbsvx(FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
SGBSVX computes the solution to system of linear equations A * X = B for GB matrices ...
Definition: sgbsvx.f:370
subroutine sgbsvxx(FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, RPVGRW, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO)
SGBSVXX computes the solution to system of linear equations A * X = B for GB matrices ...
Definition: sgbsvxx.f:565
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
subroutine ssysvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, IWORK, INFO)
SSYSVX computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: ssysvx.f:286
subroutine spbsvx(FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
SPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: spbsvx.f:345
subroutine sptsv(N, NRHS, D, E, B, LDB, INFO)
SPTSV computes the solution to system of linear equations A * X = B for PT matrices ...
Definition: sptsv.f:116
subroutine sspsvx(FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
SSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: sspsvx.f:279
subroutine sspsv(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
SSPSV computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: sspsv.f:164
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
subroutine sgesvx(FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
SGESVX computes the solution to system of linear equations A * X = B for GE matrices ...
Definition: sgesvx.f:351
subroutine sptsvx(FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, INFO)
SPTSVX computes the solution to system of linear equations A * X = B for PT matrices ...
Definition: sptsvx.f:230
subroutine sposv(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
SPOSV computes the solution to system of linear equations A * X = B for PO matrices ...
Definition: sposv.f:132
subroutine sppsvx(FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
SPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: sppsvx.f:314
subroutine sppsv(UPLO, N, NRHS, AP, B, LDB, INFO)
SPPSV computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: sppsv.f:146
subroutine spbsv(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
SPBSV computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: spbsv.f:166
subroutine sgesvxx(FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, RPVGRW, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO)
SGESVXX computes the solution to system of linear equations A * X = B for GE matrices ...
Definition: sgesvxx.f:545
subroutine serrvx(PATH, NUNIT)
SERRVX
Definition: serrvx.f:57
subroutine ssysv_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
SSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: ssysv_rook.f:206
subroutine ssysv(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
SSYSV computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: ssysv.f:173
subroutine sgtsvx(FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
SGTSVX computes the solution to system of linear equations A * X = B for GT matrices ...
Definition: sgtsvx.f:295
subroutine sposvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
SPOSVX computes the solution to system of linear equations A * X = B for PO matrices ...
Definition: sposvx.f:309
subroutine sgtsv(N, NRHS, DL, D, DU, B, LDB, INFO)
SGTSV computes the solution to system of linear equations A * X = B for GT matrices ...
Definition: sgtsv.f:129