LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
cerrvxx.f
Go to the documentation of this file.
1 *> \brief \b CERRVXX
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 CERRVX( 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 *> CERRVX tests the error exits for the COMPLEX 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 complex_lin
54 *
55 * =====================================================================
56  SUBROUTINE cerrvx( 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 )
84  REAL c( nmax ), r( nmax ), r1( nmax ), r2( nmax ),
85  $ rf( nmax ), rw( nmax ), err_bnds_n( nmax, 3 ),
86  $ err_bnds_c( nmax, 3 ), params( 1 )
87  COMPLEX a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
88  $ w( 2*nmax ), x( nmax )
89 * ..
90 * .. External Functions ..
91  LOGICAL lsamen
92  EXTERNAL lsamen
93 * ..
94 * .. External Subroutines ..
95  EXTERNAL cgbsv, cgbsvx, cgesv, cgesvx, cgtsv, cgtsvx,
100  $ chesvxx, cgbsvxx
101 * ..
102 * .. Scalars in Common ..
103  LOGICAL lerr, ok
104  CHARACTER*32 srnamt
105  INTEGER infot, nout
106 * ..
107 * .. Common blocks ..
108  COMMON / infoc / infot, nout, ok, lerr
109  COMMON / srnamc / srnamt
110 * ..
111 * .. Intrinsic Functions ..
112  INTRINSIC cmplx, real
113 * ..
114 * .. Executable Statements ..
115 *
116  nout = nunit
117  WRITE( nout, fmt = * )
118  c2 = path( 2: 3 )
119 *
120 * Set the variables to innocuous values.
121 *
122  DO 20 j = 1, nmax
123  DO 10 i = 1, nmax
124  a( i, j ) = cmplx( 1. / REAL( I+J ), -1. / REAL( I+J ) )
125  af( i, j ) = cmplx( 1. / REAL( I+J ), -1. / REAL( I+J ) )
126  10 CONTINUE
127  b( j ) = 0.
128  r1( j ) = 0.
129  r2( j ) = 0.
130  w( j ) = 0.
131  x( j ) = 0.
132  c( j ) = 0.
133  r( j ) = 0.
134  ip( j ) = j
135  20 CONTINUE
136  eq = ' '
137  ok = .true.
138 *
139  IF( lsamen( 2, c2, 'GE' ) ) THEN
140 *
141 * CGESV
142 *
143  srnamt = 'CGESV '
144  infot = 1
145  CALL cgesv( -1, 0, a, 1, ip, b, 1, info )
146  CALL chkxer( 'CGESV ', infot, nout, lerr, ok )
147  infot = 2
148  CALL cgesv( 0, -1, a, 1, ip, b, 1, info )
149  CALL chkxer( 'CGESV ', infot, nout, lerr, ok )
150  infot = 4
151  CALL cgesv( 2, 1, a, 1, ip, b, 2, info )
152  CALL chkxer( 'CGESV ', infot, nout, lerr, ok )
153  infot = 7
154  CALL cgesv( 2, 1, a, 2, ip, b, 1, info )
155  CALL chkxer( 'CGESV ', infot, nout, lerr, ok )
156 *
157 * CGESVX
158 *
159  srnamt = 'CGESVX'
160  infot = 1
161  CALL cgesvx( '/', 'N', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
162  $ x, 1, rcond, r1, r2, w, rw, info )
163  CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
164  infot = 2
165  CALL cgesvx( 'N', '/', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
166  $ x, 1, rcond, r1, r2, w, rw, info )
167  CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
168  infot = 3
169  CALL cgesvx( 'N', 'N', -1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
170  $ x, 1, rcond, r1, r2, w, rw, info )
171  CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
172  infot = 4
173  CALL cgesvx( 'N', 'N', 0, -1, a, 1, af, 1, ip, eq, r, c, b, 1,
174  $ x, 1, rcond, r1, r2, w, rw, info )
175  CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
176  infot = 6
177  CALL cgesvx( 'N', 'N', 2, 1, a, 1, af, 2, ip, eq, r, c, b, 2,
178  $ x, 2, rcond, r1, r2, w, rw, info )
179  CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
180  infot = 8
181  CALL cgesvx( 'N', 'N', 2, 1, a, 2, af, 1, ip, eq, r, c, b, 2,
182  $ x, 2, rcond, r1, r2, w, rw, info )
183  CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
184  infot = 10
185  eq = '/'
186  CALL cgesvx( 'F', 'N', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
187  $ x, 1, rcond, r1, r2, w, rw, info )
188  CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
189  infot = 11
190  eq = 'R'
191  CALL cgesvx( 'F', 'N', 1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
192  $ x, 1, rcond, r1, r2, w, rw, info )
193  CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
194  infot = 12
195  eq = 'C'
196  CALL cgesvx( 'F', 'N', 1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
197  $ x, 1, rcond, r1, r2, w, rw, info )
198  CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
199  infot = 14
200  CALL cgesvx( 'N', 'N', 2, 1, a, 2, af, 2, ip, eq, r, c, b, 1,
201  $ x, 2, rcond, r1, r2, w, rw, info )
202  CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
203  infot = 16
204  CALL cgesvx( 'N', 'N', 2, 1, a, 2, af, 2, ip, eq, r, c, b, 2,
205  $ x, 1, rcond, r1, r2, w, rw, info )
206  CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
207 *
208 * CGESVXX
209 *
210  n_err_bnds = 3
211  nparams = 1
212  srnamt = 'CGESVXX'
213  infot = 1
214  CALL cgesvxx( '/', 'N', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
215  $ x, 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
216  $ err_bnds_c, nparams, params, w, rw, info )
217  CALL chkxer( 'CGESVXX', infot, nout, lerr, ok )
218  infot = 2
219  CALL cgesvxx( 'N', '/', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
220  $ x, 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
221  $ err_bnds_c, nparams, params, w, rw, info )
222  CALL chkxer( 'CGESVXX', infot, nout, lerr, ok )
223  infot = 3
224  CALL cgesvxx( 'N', 'N', -1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
225  $ x, 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
226  $ err_bnds_c, nparams, params, w, rw, info )
227  CALL chkxer( 'CGESVXX', infot, nout, lerr, ok )
228  infot = 4
229  CALL cgesvxx( 'N', 'N', 0, -1, a, 1, af, 1, ip, eq, r, c, b, 1,
230  $ x, 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
231  $ err_bnds_c, nparams, params, w, rw, info )
232  CALL chkxer( 'CGESVXX', infot, nout, lerr, ok )
233  infot = 6
234  CALL cgesvxx( 'N', 'N', 2, 1, a, 1, af, 2, ip, eq, r, c, b, 2,
235  $ x, 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
236  $ err_bnds_c, nparams, params, w, rw, info )
237  CALL chkxer( 'CGESVXX', infot, nout, lerr, ok )
238  infot = 8
239  CALL cgesvxx( 'N', 'N', 2, 1, a, 2, af, 1, ip, eq, r, c, b, 2,
240  $ x, 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
241  $ err_bnds_c, nparams, params, w, rw, info )
242  CALL chkxer( 'CGESVXX', infot, nout, lerr, ok )
243  infot = 10
244  eq = '/'
245  CALL cgesvxx( 'F', 'N', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
246  $ x, 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
247  $ err_bnds_c, nparams, params, w, rw, info )
248  CALL chkxer( 'CGESVXX', infot, nout, lerr, ok )
249  infot = 11
250  eq = 'R'
251  CALL cgesvxx( 'F', 'N', 1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
252  $ x, 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
253  $ err_bnds_c, nparams, params, w, rw, info )
254  CALL chkxer( 'CGESVXX', infot, nout, lerr, ok )
255  infot = 12
256  eq = 'C'
257  CALL cgesvxx( 'F', 'N', 1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
258  $ x, 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
259  $ err_bnds_c, nparams, params, w, rw, info )
260  CALL chkxer( 'CGESVXX', infot, nout, lerr, ok )
261  infot = 14
262  CALL cgesvxx( 'N', 'N', 2, 1, a, 2, af, 2, ip, eq, r, c, b, 1,
263  $ x, 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
264  $ err_bnds_c, nparams, params, w, rw, info )
265  CALL chkxer( 'CGESVXX', infot, nout, lerr, ok )
266  infot = 16
267  CALL cgesvxx( 'N', 'N', 2, 1, a, 2, af, 2, ip, eq, r, c, b, 2,
268  $ x, 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
269  $ err_bnds_c, nparams, params, w, rw, info )
270  CALL chkxer( 'CGESVXX', infot, nout, lerr, ok )
271 *
272  ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
273 *
274 * CGBSV
275 *
276  srnamt = 'CGBSV '
277  infot = 1
278  CALL cgbsv( -1, 0, 0, 0, a, 1, ip, b, 1, info )
279  CALL chkxer( 'CGBSV ', infot, nout, lerr, ok )
280  infot = 2
281  CALL cgbsv( 1, -1, 0, 0, a, 1, ip, b, 1, info )
282  CALL chkxer( 'CGBSV ', infot, nout, lerr, ok )
283  infot = 3
284  CALL cgbsv( 1, 0, -1, 0, a, 1, ip, b, 1, info )
285  CALL chkxer( 'CGBSV ', infot, nout, lerr, ok )
286  infot = 4
287  CALL cgbsv( 0, 0, 0, -1, a, 1, ip, b, 1, info )
288  CALL chkxer( 'CGBSV ', infot, nout, lerr, ok )
289  infot = 6
290  CALL cgbsv( 1, 1, 1, 0, a, 3, ip, b, 1, info )
291  CALL chkxer( 'CGBSV ', infot, nout, lerr, ok )
292  infot = 9
293  CALL cgbsv( 2, 0, 0, 0, a, 1, ip, b, 1, info )
294  CALL chkxer( 'CGBSV ', infot, nout, lerr, ok )
295 *
296 * CGBSVX
297 *
298  srnamt = 'CGBSVX'
299  infot = 1
300  CALL cgbsvx( '/', 'N', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
301  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
302  CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
303  infot = 2
304  CALL cgbsvx( 'N', '/', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
305  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
306  CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
307  infot = 3
308  CALL cgbsvx( 'N', 'N', -1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
309  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
310  CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
311  infot = 4
312  CALL cgbsvx( 'N', 'N', 1, -1, 0, 0, a, 1, af, 1, ip, eq, r, c,
313  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
314  CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
315  infot = 5
316  CALL cgbsvx( 'N', 'N', 1, 0, -1, 0, a, 1, af, 1, ip, eq, r, c,
317  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
318  CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
319  infot = 6
320  CALL cgbsvx( 'N', 'N', 0, 0, 0, -1, a, 1, af, 1, ip, eq, r, c,
321  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
322  CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
323  infot = 8
324  CALL cgbsvx( 'N', 'N', 1, 1, 1, 0, a, 2, af, 4, ip, eq, r, c,
325  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
326  CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
327  infot = 10
328  CALL cgbsvx( 'N', 'N', 1, 1, 1, 0, a, 3, af, 3, ip, eq, r, c,
329  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
330  CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
331  infot = 12
332  eq = '/'
333  CALL cgbsvx( 'F', 'N', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
334  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
335  CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
336  infot = 13
337  eq = 'R'
338  CALL cgbsvx( 'F', 'N', 1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
339  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
340  CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
341  infot = 14
342  eq = 'C'
343  CALL cgbsvx( 'F', 'N', 1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
344  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
345  CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
346  infot = 16
347  CALL cgbsvx( 'N', 'N', 2, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
348  $ b, 1, x, 2, rcond, r1, r2, w, rw, info )
349  CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
350  infot = 18
351  CALL cgbsvx( 'N', 'N', 2, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
352  $ b, 2, x, 1, rcond, r1, r2, w, rw, info )
353  CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
354 *
355 * CGBSVXX
356 *
357  n_err_bnds = 3
358  nparams = 1
359  srnamt = 'CGBSVXX'
360  infot = 1
361  CALL cgbsvxx( '/', 'N', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
362  $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
363  $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
364  $ info )
365  CALL chkxer( 'CGBSVXX', infot, nout, lerr, ok )
366  infot = 2
367  CALL cgbsvxx( 'N', '/', 0, 1, 1, 0, a, 1, af, 1, ip, eq, r, c,
368  $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
369  $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
370  $ info )
371  CALL chkxer( 'CGBSVXX', infot, nout, lerr, ok )
372  infot = 3
373  CALL cgbsvxx( 'N', 'N', -1, 1, 1, 0, a, 1, af, 1, ip, eq, r, c,
374  $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
375  $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
376  $ info )
377  CALL chkxer( 'CGBSVXX', infot, nout, lerr, ok )
378  infot = 4
379  CALL cgbsvxx( 'N', 'N', 2, -1, 1, 0, a, 1, af, 1, ip, eq,
380  $ r, c, b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
381  $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
382  $ info )
383  CALL chkxer( 'CGBSVXX', infot, nout, lerr, ok )
384  infot = 5
385  CALL cgbsvxx( 'N', 'N', 2, 1, -1, 0, a, 1, af, 1, ip, eq,
386  $ r, c, b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
387  $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
388  $ info )
389  CALL chkxer( 'CGBSVXX', infot, nout, lerr, ok )
390  infot = 6
391  CALL cgbsvxx( 'N', 'N', 0, 1, 1, -1, a, 1, af, 1, ip, eq, r, c,
392  $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
393  $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
394  $ info )
395  CALL chkxer( 'CGBSVXX', infot, nout, lerr, ok )
396  infot = 8
397  CALL cgbsvxx( 'N', 'N', 2, 1, 1, 1, a, 2, af, 2, ip, eq, r, c,
398  $ b, 2, x, 2, rcond, rpvgrw, berr, n_err_bnds,
399  $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
400  $ info )
401  CALL chkxer( 'CGBSVXX', infot, nout, lerr, ok )
402  infot = 10
403  CALL cgbsvxx( 'N', 'N', 2, 1, 1, 1, a, 3, af, 3, ip, eq, r, c,
404  $ b, 2, x, 2, rcond, rpvgrw, berr, n_err_bnds,
405  $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
406  $ info )
407  CALL chkxer( 'CGBSVXX', infot, nout, lerr, ok )
408  infot = 12
409  eq = '/'
410  CALL cgbsvxx( 'F', 'N', 0, 1, 1, 0, a, 3, af, 4, ip, eq, r, c,
411  $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
412  $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
413  $ info )
414  CALL chkxer( 'CGBSVXX', infot, nout, lerr, ok )
415  infot = 13
416  eq = 'R'
417  CALL cgbsvxx( 'F', 'N', 1, 1, 1, 0, a, 3, af, 4, ip, eq, r, c,
418  $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
419  $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
420  $ info )
421  CALL chkxer( 'CGBSVXX', infot, nout, lerr, ok )
422  infot = 14
423  eq = 'C'
424  CALL cgbsvxx( 'F', 'N', 1, 1, 1, 0, a, 3, af, 4, ip, eq, r, c,
425  $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
426  $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
427  $ info )
428  CALL chkxer( 'CGBSVXX', infot, nout, lerr, ok )
429  infot = 15
430  CALL cgbsvxx( 'N', 'N', 2, 1, 1, 1, a, 3, af, 4, ip, eq, r, c,
431  $ b, 1, x, 2, rcond, rpvgrw, berr, n_err_bnds,
432  $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
433  $ info )
434  CALL chkxer( 'CGBSVXX', infot, nout, lerr, ok )
435  infot = 16
436  CALL cgbsvxx( 'N', 'N', 2, 1, 1, 1, a, 3, af, 4, ip, eq, r, c,
437  $ b, 2, x, 1, rcond, rpvgrw, berr, n_err_bnds,
438  $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
439  $ info )
440  CALL chkxer( 'CGBSVXX', infot, nout, lerr, ok )
441 *
442  ELSE IF( lsamen( 2, c2, 'GT' ) ) THEN
443 *
444 * CGTSV
445 *
446  srnamt = 'CGTSV '
447  infot = 1
448  CALL cgtsv( -1, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1,
449  $ info )
450  CALL chkxer( 'CGTSV ', infot, nout, lerr, ok )
451  infot = 2
452  CALL cgtsv( 0, -1, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1,
453  $ info )
454  CALL chkxer( 'CGTSV ', infot, nout, lerr, ok )
455  infot = 7
456  CALL cgtsv( 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1, info )
457  CALL chkxer( 'CGTSV ', infot, nout, lerr, ok )
458 *
459 * CGTSVX
460 *
461  srnamt = 'CGTSVX'
462  infot = 1
463  CALL cgtsvx( '/', 'N', 0, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
464  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
465  $ ip, b, 1, x, 1, rcond, r1, r2, w, rw, info )
466  CALL chkxer( 'CGTSVX', infot, nout, lerr, ok )
467  infot = 2
468  CALL cgtsvx( 'N', '/', 0, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
469  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
470  $ ip, b, 1, x, 1, rcond, r1, r2, w, rw, info )
471  CALL chkxer( 'CGTSVX', infot, nout, lerr, ok )
472  infot = 3
473  CALL cgtsvx( 'N', 'N', -1, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
474  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
475  $ ip, b, 1, x, 1, rcond, r1, r2, w, rw, info )
476  CALL chkxer( 'CGTSVX', infot, nout, lerr, ok )
477  infot = 4
478  CALL cgtsvx( 'N', 'N', 0, -1, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
479  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
480  $ ip, b, 1, x, 1, rcond, r1, r2, w, rw, info )
481  CALL chkxer( 'CGTSVX', infot, nout, lerr, ok )
482  infot = 14
483  CALL cgtsvx( 'N', 'N', 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
484  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
485  $ ip, b, 1, x, 2, rcond, r1, r2, w, rw, info )
486  CALL chkxer( 'CGTSVX', infot, nout, lerr, ok )
487  infot = 16
488  CALL cgtsvx( 'N', 'N', 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
489  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
490  $ ip, b, 2, x, 1, rcond, r1, r2, w, rw, info )
491  CALL chkxer( 'CGTSVX', infot, nout, lerr, ok )
492 *
493  ELSE IF( lsamen( 2, c2, 'PO' ) ) THEN
494 *
495 * CPOSV
496 *
497  srnamt = 'CPOSV '
498  infot = 1
499  CALL cposv( '/', 0, 0, a, 1, b, 1, info )
500  CALL chkxer( 'CPOSV ', infot, nout, lerr, ok )
501  infot = 2
502  CALL cposv( 'U', -1, 0, a, 1, b, 1, info )
503  CALL chkxer( 'CPOSV ', infot, nout, lerr, ok )
504  infot = 3
505  CALL cposv( 'U', 0, -1, a, 1, b, 1, info )
506  CALL chkxer( 'CPOSV ', infot, nout, lerr, ok )
507  infot = 5
508  CALL cposv( 'U', 2, 0, a, 1, b, 2, info )
509  CALL chkxer( 'CPOSV ', infot, nout, lerr, ok )
510  infot = 7
511  CALL cposv( 'U', 2, 0, a, 2, b, 1, info )
512  CALL chkxer( 'CPOSV ', infot, nout, lerr, ok )
513 *
514 * CPOSVX
515 *
516  srnamt = 'CPOSVX'
517  infot = 1
518  CALL cposvx( '/', 'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
519  $ rcond, r1, r2, w, rw, info )
520  CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
521  infot = 2
522  CALL cposvx( 'N', '/', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
523  $ rcond, r1, r2, w, rw, info )
524  CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
525  infot = 3
526  CALL cposvx( 'N', 'U', -1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
527  $ rcond, r1, r2, w, rw, info )
528  CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
529  infot = 4
530  CALL cposvx( 'N', 'U', 0, -1, a, 1, af, 1, eq, c, b, 1, x, 1,
531  $ rcond, r1, r2, w, rw, info )
532  CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
533  infot = 6
534  CALL cposvx( 'N', 'U', 2, 0, a, 1, af, 2, eq, c, b, 2, x, 2,
535  $ rcond, r1, r2, w, rw, info )
536  CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
537  infot = 8
538  CALL cposvx( 'N', 'U', 2, 0, a, 2, af, 1, eq, c, b, 2, x, 2,
539  $ rcond, r1, r2, w, rw, info )
540  CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
541  infot = 9
542  eq = '/'
543  CALL cposvx( 'F', 'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
544  $ rcond, r1, r2, w, rw, info )
545  CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
546  infot = 10
547  eq = 'Y'
548  CALL cposvx( 'F', 'U', 1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
549  $ rcond, r1, r2, w, rw, info )
550  CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
551  infot = 12
552  CALL cposvx( 'N', 'U', 2, 0, a, 2, af, 2, eq, c, b, 1, x, 2,
553  $ rcond, r1, r2, w, rw, info )
554  CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
555  infot = 14
556  CALL cposvx( 'N', 'U', 2, 0, a, 2, af, 2, eq, c, b, 2, x, 1,
557  $ rcond, r1, r2, w, rw, info )
558  CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
559 *
560 * CPOSVXX
561 *
562  n_err_bnds = 3
563  nparams = 1
564  srnamt = 'CPOSVXX'
565  infot = 1
566  CALL cposvxx( '/', 'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
567  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
568  $ err_bnds_c, nparams, params, w, rw, info )
569  CALL chkxer( 'CPOSVXX', infot, nout, lerr, ok )
570  infot = 2
571  CALL cposvxx( 'N', '/', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
572  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
573  $ err_bnds_c, nparams, params, w, rw, info )
574  CALL chkxer( 'CPOSVXX', infot, nout, lerr, ok )
575  infot = 3
576  CALL cposvxx( 'N', 'U', -1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
577  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
578  $ err_bnds_c, nparams, params, w, rw, info )
579  CALL chkxer( 'CPOSVXX', infot, nout, lerr, ok )
580  infot = 4
581  CALL cposvxx( 'N', 'U', 0, -1, a, 1, af, 1, eq, c, b, 1, x, 1,
582  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
583  $ err_bnds_c, nparams, params, w, rw, info )
584  CALL chkxer( 'CPOSVXX', infot, nout, lerr, ok )
585  infot = 6
586  CALL cposvxx( 'N', 'U', 2, 0, a, 1, af, 2, eq, c, b, 2, x, 2,
587  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
588  $ err_bnds_c, nparams, params, w, rw, info )
589  CALL chkxer( 'CPOSVXX', infot, nout, lerr, ok )
590  infot = 8
591  CALL cposvxx( 'N', 'U', 2, 0, a, 2, af, 1, eq, c, b, 2, x, 2,
592  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
593  $ err_bnds_c, nparams, params, w, rw, info )
594  CALL chkxer( 'CPOSVXX', infot, nout, lerr, ok )
595  infot = 9
596  eq = '/'
597  CALL cposvxx( 'F', 'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
598  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
599  $ err_bnds_c, nparams, params, w, rw, info )
600  CALL chkxer( 'CPOSVXX', infot, nout, lerr, ok )
601  infot = 10
602  eq = 'Y'
603  CALL cposvxx( 'F', 'U', 1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
604  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
605  $ err_bnds_c, nparams, params, w, rw, info )
606  CALL chkxer( 'CPOSVXX', infot, nout, lerr, ok )
607  infot = 12
608  CALL cposvxx( 'N', 'U', 2, 0, a, 2, af, 2, eq, c, b, 1, x, 2,
609  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
610  $ err_bnds_c, nparams, params, w, rw, info )
611  CALL chkxer( 'CPOSVXX', infot, nout, lerr, ok )
612  infot = 14
613  CALL cposvxx( 'N', 'U', 2, 0, a, 2, af, 2, eq, c, b, 2, x, 1,
614  $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
615  $ err_bnds_c, nparams, params, w, rw, info )
616  CALL chkxer( 'CPOSVXX', infot, nout, lerr, ok )
617 *
618  ELSE IF( lsamen( 2, c2, 'PP' ) ) THEN
619 *
620 * CPPSV
621 *
622  srnamt = 'CPPSV '
623  infot = 1
624  CALL cppsv( '/', 0, 0, a, b, 1, info )
625  CALL chkxer( 'CPPSV ', infot, nout, lerr, ok )
626  infot = 2
627  CALL cppsv( 'U', -1, 0, a, b, 1, info )
628  CALL chkxer( 'CPPSV ', infot, nout, lerr, ok )
629  infot = 3
630  CALL cppsv( 'U', 0, -1, a, b, 1, info )
631  CALL chkxer( 'CPPSV ', infot, nout, lerr, ok )
632  infot = 6
633  CALL cppsv( 'U', 2, 0, a, b, 1, info )
634  CALL chkxer( 'CPPSV ', infot, nout, lerr, ok )
635 *
636 * CPPSVX
637 *
638  srnamt = 'CPPSVX'
639  infot = 1
640  CALL cppsvx( '/', 'U', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
641  $ r1, r2, w, rw, info )
642  CALL chkxer( 'CPPSVX', infot, nout, lerr, ok )
643  infot = 2
644  CALL cppsvx( 'N', '/', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
645  $ r1, r2, w, rw, info )
646  CALL chkxer( 'CPPSVX', infot, nout, lerr, ok )
647  infot = 3
648  CALL cppsvx( 'N', 'U', -1, 0, a, af, eq, c, b, 1, x, 1, rcond,
649  $ r1, r2, w, rw, info )
650  CALL chkxer( 'CPPSVX', infot, nout, lerr, ok )
651  infot = 4
652  CALL cppsvx( 'N', 'U', 0, -1, a, af, eq, c, b, 1, x, 1, rcond,
653  $ r1, r2, w, rw, info )
654  CALL chkxer( 'CPPSVX', infot, nout, lerr, ok )
655  infot = 7
656  eq = '/'
657  CALL cppsvx( 'F', 'U', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
658  $ r1, r2, w, rw, info )
659  CALL chkxer( 'CPPSVX', infot, nout, lerr, ok )
660  infot = 8
661  eq = 'Y'
662  CALL cppsvx( 'F', 'U', 1, 0, a, af, eq, c, b, 1, x, 1, rcond,
663  $ r1, r2, w, rw, info )
664  CALL chkxer( 'CPPSVX', infot, nout, lerr, ok )
665  infot = 10
666  CALL cppsvx( 'N', 'U', 2, 0, a, af, eq, c, b, 1, x, 2, rcond,
667  $ r1, r2, w, rw, info )
668  CALL chkxer( 'CPPSVX', infot, nout, lerr, ok )
669  infot = 12
670  CALL cppsvx( 'N', 'U', 2, 0, a, af, eq, c, b, 2, x, 1, rcond,
671  $ r1, r2, w, rw, info )
672  CALL chkxer( 'CPPSVX', infot, nout, lerr, ok )
673 *
674  ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
675 *
676 * CPBSV
677 *
678  srnamt = 'CPBSV '
679  infot = 1
680  CALL cpbsv( '/', 0, 0, 0, a, 1, b, 1, info )
681  CALL chkxer( 'CPBSV ', infot, nout, lerr, ok )
682  infot = 2
683  CALL cpbsv( 'U', -1, 0, 0, a, 1, b, 1, info )
684  CALL chkxer( 'CPBSV ', infot, nout, lerr, ok )
685  infot = 3
686  CALL cpbsv( 'U', 1, -1, 0, a, 1, b, 1, info )
687  CALL chkxer( 'CPBSV ', infot, nout, lerr, ok )
688  infot = 4
689  CALL cpbsv( 'U', 0, 0, -1, a, 1, b, 1, info )
690  CALL chkxer( 'CPBSV ', infot, nout, lerr, ok )
691  infot = 6
692  CALL cpbsv( 'U', 1, 1, 0, a, 1, b, 2, info )
693  CALL chkxer( 'CPBSV ', infot, nout, lerr, ok )
694  infot = 8
695  CALL cpbsv( 'U', 2, 0, 0, a, 1, b, 1, info )
696  CALL chkxer( 'CPBSV ', infot, nout, lerr, ok )
697 *
698 * CPBSVX
699 *
700  srnamt = 'CPBSVX'
701  infot = 1
702  CALL cpbsvx( '/', 'U', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
703  $ rcond, r1, r2, w, rw, info )
704  CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
705  infot = 2
706  CALL cpbsvx( 'N', '/', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
707  $ rcond, r1, r2, w, rw, info )
708  CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
709  infot = 3
710  CALL cpbsvx( 'N', 'U', -1, 0, 0, a, 1, af, 1, eq, c, b, 1, x,
711  $ 1, rcond, r1, r2, w, rw, info )
712  CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
713  infot = 4
714  CALL cpbsvx( 'N', 'U', 1, -1, 0, a, 1, af, 1, eq, c, b, 1, x,
715  $ 1, rcond, r1, r2, w, rw, info )
716  CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
717  infot = 5
718  CALL cpbsvx( 'N', 'U', 0, 0, -1, a, 1, af, 1, eq, c, b, 1, x,
719  $ 1, rcond, r1, r2, w, rw, info )
720  CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
721  infot = 7
722  CALL cpbsvx( 'N', 'U', 1, 1, 0, a, 1, af, 2, eq, c, b, 2, x, 2,
723  $ rcond, r1, r2, w, rw, info )
724  CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
725  infot = 9
726  CALL cpbsvx( 'N', 'U', 1, 1, 0, a, 2, af, 1, eq, c, b, 2, x, 2,
727  $ rcond, r1, r2, w, rw, info )
728  CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
729  infot = 10
730  eq = '/'
731  CALL cpbsvx( 'F', 'U', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
732  $ rcond, r1, r2, w, rw, info )
733  CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
734  infot = 11
735  eq = 'Y'
736  CALL cpbsvx( 'F', 'U', 1, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
737  $ rcond, r1, r2, w, rw, info )
738  CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
739  infot = 13
740  CALL cpbsvx( 'N', 'U', 2, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 2,
741  $ rcond, r1, r2, w, rw, info )
742  CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
743  infot = 15
744  CALL cpbsvx( 'N', 'U', 2, 0, 0, a, 1, af, 1, eq, c, b, 2, x, 1,
745  $ rcond, r1, r2, w, rw, info )
746  CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
747 *
748  ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
749 *
750 * CPTSV
751 *
752  srnamt = 'CPTSV '
753  infot = 1
754  CALL cptsv( -1, 0, r, a( 1, 1 ), b, 1, info )
755  CALL chkxer( 'CPTSV ', infot, nout, lerr, ok )
756  infot = 2
757  CALL cptsv( 0, -1, r, a( 1, 1 ), b, 1, info )
758  CALL chkxer( 'CPTSV ', infot, nout, lerr, ok )
759  infot = 6
760  CALL cptsv( 2, 0, r, a( 1, 1 ), b, 1, info )
761  CALL chkxer( 'CPTSV ', infot, nout, lerr, ok )
762 *
763 * CPTSVX
764 *
765  srnamt = 'CPTSVX'
766  infot = 1
767  CALL cptsvx( '/', 0, 0, r, a( 1, 1 ), rf, af( 1, 1 ), b, 1, x,
768  $ 1, rcond, r1, r2, w, rw, info )
769  CALL chkxer( 'CPTSVX', infot, nout, lerr, ok )
770  infot = 2
771  CALL cptsvx( 'N', -1, 0, r, a( 1, 1 ), rf, af( 1, 1 ), b, 1, x,
772  $ 1, rcond, r1, r2, w, rw, info )
773  CALL chkxer( 'CPTSVX', infot, nout, lerr, ok )
774  infot = 3
775  CALL cptsvx( 'N', 0, -1, r, a( 1, 1 ), rf, af( 1, 1 ), b, 1, x,
776  $ 1, rcond, r1, r2, w, rw, info )
777  CALL chkxer( 'CPTSVX', infot, nout, lerr, ok )
778  infot = 9
779  CALL cptsvx( 'N', 2, 0, r, a( 1, 1 ), rf, af( 1, 1 ), b, 1, x,
780  $ 2, rcond, r1, r2, w, rw, info )
781  CALL chkxer( 'CPTSVX', infot, nout, lerr, ok )
782  infot = 11
783  CALL cptsvx( 'N', 2, 0, r, a( 1, 1 ), rf, af( 1, 1 ), b, 2, x,
784  $ 1, rcond, r1, r2, w, rw, info )
785  CALL chkxer( 'CPTSVX', infot, nout, lerr, ok )
786 *
787  ELSE IF( lsamen( 2, c2, 'HE' ) ) THEN
788 *
789 * CHESV
790 *
791  srnamt = 'CHESV '
792  infot = 1
793  CALL chesv( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
794  CALL chkxer( 'CHESV ', infot, nout, lerr, ok )
795  infot = 2
796  CALL chesv( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
797  CALL chkxer( 'CHESV ', infot, nout, lerr, ok )
798  infot = 3
799  CALL chesv( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
800  CALL chkxer( 'CHESV ', infot, nout, lerr, ok )
801  infot = 5
802  CALL chesv( 'U', 2, 0, a, 1, ip, b, 2, w, 1, info )
803  CALL chkxer( 'CHESV ', infot, nout, lerr, ok )
804  infot = 8
805  CALL chesv( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
806  CALL chkxer( 'CHESV ', infot, nout, lerr, ok )
807 *
808 * CHESVX
809 *
810  srnamt = 'CHESVX'
811  infot = 1
812  CALL chesvx( '/', 'U', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
813  $ rcond, r1, r2, w, 1, rw, info )
814  CALL chkxer( 'CHESVX', infot, nout, lerr, ok )
815  infot = 2
816  CALL chesvx( 'N', '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
817  $ rcond, r1, r2, w, 1, rw, info )
818  CALL chkxer( 'CHESVX', infot, nout, lerr, ok )
819  infot = 3
820  CALL chesvx( 'N', 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1,
821  $ rcond, r1, r2, w, 1, rw, info )
822  CALL chkxer( 'CHESVX', infot, nout, lerr, ok )
823  infot = 4
824  CALL chesvx( 'N', 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1,
825  $ rcond, r1, r2, w, 1, rw, info )
826  CALL chkxer( 'CHESVX', infot, nout, lerr, ok )
827  infot = 6
828  CALL chesvx( 'N', 'U', 2, 0, a, 1, af, 2, ip, b, 2, x, 2,
829  $ rcond, r1, r2, w, 4, rw, info )
830  CALL chkxer( 'CHESVX', infot, nout, lerr, ok )
831  infot = 8
832  CALL chesvx( 'N', 'U', 2, 0, a, 2, af, 1, ip, b, 2, x, 2,
833  $ rcond, r1, r2, w, 4, rw, info )
834  CALL chkxer( 'CHESVX', infot, nout, lerr, ok )
835  infot = 11
836  CALL chesvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 1, x, 2,
837  $ rcond, r1, r2, w, 4, rw, info )
838  CALL chkxer( 'CHESVX', infot, nout, lerr, ok )
839  infot = 13
840  CALL chesvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 1,
841  $ rcond, r1, r2, w, 4, rw, info )
842  CALL chkxer( 'CHESVX', infot, nout, lerr, ok )
843  infot = 18
844  CALL chesvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 2,
845  $ rcond, r1, r2, w, 3, rw, info )
846  CALL chkxer( 'CHESVX', infot, nout, lerr, ok )
847 *
848 * CHESVXX
849 *
850  n_err_bnds = 3
851  nparams = 1
852  srnamt = 'CHESVXX'
853  infot = 1
854  CALL chesvxx( '/', 'U', 0, 0, a, 1, af, 1, ip, eq, c, b, 1, x,
855  $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
856  $ err_bnds_c, nparams, params, w, rw, info )
857  CALL chkxer( 'CHESVXX', infot, nout, lerr, ok )
858  infot = 2
859  CALL chesvxx( 'N', '/', 0, 0, a, 1, af, 1, ip, eq, c, b, 1, x,
860  $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
861  $ err_bnds_c, nparams, params, w, rw, info )
862  CALL chkxer( 'CHESVXX', infot, nout, lerr, ok )
863  infot = 3
864  CALL chesvxx( 'N', 'U', -1, 0, a, 1, af, 1, ip, eq, c, b, 1, x,
865  $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
866  $ err_bnds_c, nparams, params, w, rw, info )
867  CALL chkxer( 'CHESVXX', infot, nout, lerr, ok )
868  infot = 4
869  CALL chesvxx( 'N', 'U', 0, -1, a, 1, af, 1, ip, eq, c, b, 1, x,
870  $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
871  $ err_bnds_c, nparams, params, w, rw, info )
872  CALL chkxer( 'CHESVXX', infot, nout, lerr, ok )
873  infot = 6
874  CALL chesvxx( 'N', 'U', 2, 0, a, 1, af, 2, ip, eq, c, b, 2, x,
875  $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
876  $ err_bnds_c, nparams, params, w, rw, info )
877  CALL chkxer( 'CHESVXX', infot, nout, lerr, ok )
878  infot = 8
879  CALL chesvxx( 'N', 'U', 2, 0, a, 2, af, 1, ip, eq, c, b, 2, x,
880  $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
881  $ err_bnds_c, nparams, params, w, rw, info )
882  CALL chkxer( 'CHESVXX', infot, nout, lerr, ok )
883  infot = 9
884  eq = '/'
885  CALL chesvxx( 'F', 'U', 0, 0, a, 1, af, 1, ip, eq, c, b, 1, x,
886  $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
887  $ err_bnds_c, nparams, params, w, rw, info )
888  CALL chkxer( 'CHESVXX', infot, nout, lerr, ok )
889  infot = 10
890  eq = 'Y'
891  CALL chesvxx( 'F', 'U', 1, 0, a, 1, af, 1, ip, eq, c, b, 1, x,
892  $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
893  $ err_bnds_c, nparams, params, w, rw, info )
894  CALL chkxer( 'CHESVXX', infot, nout, lerr, ok )
895  infot = 12
896  CALL chesvxx( 'N', 'U', 2, 0, a, 2, af, 2, ip, eq, c, b, 1, x,
897  $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
898  $ err_bnds_c, nparams, params, w, rw, info )
899  CALL chkxer( 'CHESVXX', infot, nout, lerr, ok )
900  infot = 14
901  CALL chesvxx( 'N', 'U', 2, 0, a, 2, af, 2, ip, eq, c, b, 2, x,
902  $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
903  $ err_bnds_c, nparams, params, w, rw, info )
904  CALL chkxer( 'CHESVXX', infot, nout, lerr, ok )
905 *
906  ELSE IF( lsamen( 2, c2, 'HR' ) ) THEN
907 *
908 * CHESV_ROOK
909 *
910  srnamt = 'CHESV_ROOK'
911  infot = 1
912  CALL chesv_rook( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
913  CALL chkxer( 'CHESV_ROOK', infot, nout, lerr, ok )
914  infot = 2
915  CALL chesv_rook( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
916  CALL chkxer( 'CHESV_ROOK', infot, nout, lerr, ok )
917  infot = 3
918  CALL chesv_rook( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
919  CALL chkxer( 'CHESV_ROOK', infot, nout, lerr, ok )
920  infot = 8
921  CALL chesv_rook( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
922  CALL chkxer( 'CHESV_ROOK', infot, nout, lerr, ok )
923 *
924  ELSE IF( lsamen( 2, c2, 'HP' ) ) THEN
925 *
926 * CHPSV
927 *
928  srnamt = 'CHPSV '
929  infot = 1
930  CALL chpsv( '/', 0, 0, a, ip, b, 1, info )
931  CALL chkxer( 'CHPSV ', infot, nout, lerr, ok )
932  infot = 2
933  CALL chpsv( 'U', -1, 0, a, ip, b, 1, info )
934  CALL chkxer( 'CHPSV ', infot, nout, lerr, ok )
935  infot = 3
936  CALL chpsv( 'U', 0, -1, a, ip, b, 1, info )
937  CALL chkxer( 'CHPSV ', infot, nout, lerr, ok )
938  infot = 7
939  CALL chpsv( 'U', 2, 0, a, ip, b, 1, info )
940  CALL chkxer( 'CHPSV ', infot, nout, lerr, ok )
941 *
942 * CHPSVX
943 *
944  srnamt = 'CHPSVX'
945  infot = 1
946  CALL chpsvx( '/', 'U', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
947  $ r2, w, rw, info )
948  CALL chkxer( 'CHPSVX', infot, nout, lerr, ok )
949  infot = 2
950  CALL chpsvx( 'N', '/', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
951  $ r2, w, rw, info )
952  CALL chkxer( 'CHPSVX', infot, nout, lerr, ok )
953  infot = 3
954  CALL chpsvx( 'N', 'U', -1, 0, a, af, ip, b, 1, x, 1, rcond, r1,
955  $ r2, w, rw, info )
956  CALL chkxer( 'CHPSVX', infot, nout, lerr, ok )
957  infot = 4
958  CALL chpsvx( 'N', 'U', 0, -1, a, af, ip, b, 1, x, 1, rcond, r1,
959  $ r2, w, rw, info )
960  CALL chkxer( 'CHPSVX', infot, nout, lerr, ok )
961  infot = 9
962  CALL chpsvx( 'N', 'U', 2, 0, a, af, ip, b, 1, x, 2, rcond, r1,
963  $ r2, w, rw, info )
964  CALL chkxer( 'CHPSVX', infot, nout, lerr, ok )
965  infot = 11
966  CALL chpsvx( 'N', 'U', 2, 0, a, af, ip, b, 2, x, 1, rcond, r1,
967  $ r2, w, rw, info )
968  CALL chkxer( 'CHPSVX', infot, nout, lerr, ok )
969 *
970  ELSE IF( lsamen( 2, c2, 'SY' ) ) THEN
971 *
972 * CSYSV
973 *
974  srnamt = 'CSYSV '
975  infot = 1
976  CALL csysv( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
977  CALL chkxer( 'CSYSV ', infot, nout, lerr, ok )
978  infot = 2
979  CALL csysv( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
980  CALL chkxer( 'CSYSV ', infot, nout, lerr, ok )
981  infot = 3
982  CALL csysv( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
983  CALL chkxer( 'CSYSV ', infot, nout, lerr, ok )
984  infot = 8
985  CALL csysv( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
986  CALL chkxer( 'CSYSV ', infot, nout, lerr, ok )
987 *
988 * CSYSVX
989 *
990  srnamt = 'CSYSVX'
991  infot = 1
992  CALL csysvx( '/', 'U', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
993  $ rcond, r1, r2, w, 1, rw, info )
994  CALL chkxer( 'CSYSVX', infot, nout, lerr, ok )
995  infot = 2
996  CALL csysvx( 'N', '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
997  $ rcond, r1, r2, w, 1, rw, info )
998  CALL chkxer( 'CSYSVX', infot, nout, lerr, ok )
999  infot = 3
1000  CALL csysvx( 'N', 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1,
1001  $ rcond, r1, r2, w, 1, rw, info )
1002  CALL chkxer( 'CSYSVX', infot, nout, lerr, ok )
1003  infot = 4
1004  CALL csysvx( 'N', 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1,
1005  $ rcond, r1, r2, w, 1, rw, info )
1006  CALL chkxer( 'CSYSVX', infot, nout, lerr, ok )
1007  infot = 6
1008  CALL csysvx( 'N', 'U', 2, 0, a, 1, af, 2, ip, b, 2, x, 2,
1009  $ rcond, r1, r2, w, 4, rw, info )
1010  CALL chkxer( 'CSYSVX', infot, nout, lerr, ok )
1011  infot = 8
1012  CALL csysvx( 'N', 'U', 2, 0, a, 2, af, 1, ip, b, 2, x, 2,
1013  $ rcond, r1, r2, w, 4, rw, info )
1014  CALL chkxer( 'CSYSVX', infot, nout, lerr, ok )
1015  infot = 11
1016  CALL csysvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 1, x, 2,
1017  $ rcond, r1, r2, w, 4, rw, info )
1018  CALL chkxer( 'CSYSVX', infot, nout, lerr, ok )
1019  infot = 13
1020  CALL csysvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 1,
1021  $ rcond, r1, r2, w, 4, rw, info )
1022  CALL chkxer( 'CSYSVX', infot, nout, lerr, ok )
1023  infot = 18
1024  CALL csysvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 2,
1025  $ rcond, r1, r2, w, 3, rw, info )
1026  CALL chkxer( 'CSYSVX', infot, nout, lerr, ok )
1027 *
1028 * CSYSVXX
1029 *
1030  n_err_bnds = 3
1031  nparams = 1
1032  srnamt = 'CSYSVXX'
1033  infot = 1
1034  eq = 'N'
1035  CALL csysvxx( '/', 'U', 0, 0, a, 1, af, 1, ip, eq, r, b, 1, x,
1036  $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1037  $ err_bnds_c, nparams, params, w, rw, info )
1038  CALL chkxer( 'CSYSVXX', infot, nout, lerr, ok )
1039  infot = 2
1040  CALL csysvxx( 'N', '/', 0, 0, a, 1, af, 1, ip, eq, r, b, 1, x,
1041  $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1042  $ err_bnds_c, nparams, params, w, rw, info )
1043  CALL chkxer( 'CSYSVXX', infot, nout, lerr, ok )
1044  infot = 3
1045  CALL csysvxx( 'N', 'U', -1, 0, a, 1, af, 1, ip, eq, r, b, 1, x,
1046  $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1047  $ err_bnds_c, nparams, params, w, rw, info )
1048  CALL chkxer( 'CSYSVXX', infot, nout, lerr, ok )
1049  infot = 4
1050  eq = '/'
1051  CALL csysvxx( 'N', 'U', 0, -1, a, 1, af, 1, ip, eq, r, b, 1, x,
1052  $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1053  $ err_bnds_c, nparams, params, w, rw, info )
1054  CALL chkxer( 'CSYSVXX', infot, nout, lerr, ok )
1055  eq = 'Y'
1056  infot = 6
1057  CALL csysvxx( 'N', 'U', 2, 0, a, 1, af, 2, ip, eq, r, b, 2, x,
1058  $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1059  $ err_bnds_c, nparams, params, w, rw, info )
1060  CALL chkxer( 'CSYSVXX', infot, nout, lerr, ok )
1061  infot = 8
1062  CALL csysvxx( 'N', 'U', 2, 0, a, 2, af, 1, ip, eq, r, b, 2, x,
1063  $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1064  $ err_bnds_c, nparams, params, w, rw, info )
1065  CALL chkxer( 'CSYSVXX', infot, nout, lerr, ok )
1066  infot = 10
1067  CALL csysvxx( 'F', 'U', 2, 0, a, 2, af, 2, ip, 'A', r, b, 2, x,
1068  $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1069  $ err_bnds_c, nparams, params, w, rw, info )
1070  CALL chkxer( 'CSYSVXX', infot, nout, lerr, ok )
1071  infot = 11
1072  eq='Y'
1073  CALL csysvxx( 'F', 'U', 2, 0, a, 2, af, 2, ip, eq, r, b, 2, x,
1074  $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1075  $ err_bnds_c, nparams, params, w, rw, info )
1076  CALL chkxer( 'CSYSVXX', infot, nout, lerr, ok )
1077  infot = 11
1078  eq='Y'
1079  r(1) = -one
1080  CALL csysvxx( 'F', 'U', 2, 0, a, 2, af, 2, ip, eq, r, b, 2, x,
1081  $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1082  $ err_bnds_c, nparams, params, w, rw, info )
1083  CALL chkxer( 'CSYSVXX', infot, nout, lerr, ok )
1084  infot = 13
1085  eq = 'N'
1086  CALL csysvxx( 'N', 'U', 2, 0, a, 2, af, 2, ip, eq, r, b, 1, x,
1087  $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1088  $ err_bnds_c, nparams, params, w, rw, info )
1089  CALL chkxer( 'CSYSVXX', infot, nout, lerr, ok )
1090  infot = 15
1091  CALL csysvxx( 'N', 'U', 2, 0, a, 2, af, 2, ip, eq, r, b, 2, x,
1092  $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1093  $ err_bnds_c, nparams, params, w, rw, info )
1094  CALL chkxer( 'CSYSVXX', infot, nout, lerr, ok )
1095 *
1096  ELSE IF( lsamen( 2, c2, 'SR' ) ) THEN
1097 *
1098 * CSYSV_ROOK
1099 *
1100  srnamt = 'CSYSV_ROOK'
1101  infot = 1
1102  CALL csysv_rook( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
1103  CALL chkxer( 'CSYSV_ROOK', infot, nout, lerr, ok )
1104  infot = 2
1105  CALL csysv_rook( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
1106  CALL chkxer( 'CSYSV_ROOK', infot, nout, lerr, ok )
1107  infot = 3
1108  CALL csysv_rook( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
1109  CALL chkxer( 'CSYSV_ROOK', infot, nout, lerr, ok )
1110  infot = 8
1111  CALL csysv_rook( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
1112  CALL chkxer( 'CSYSV_ROOK', infot, nout, lerr, ok )
1113 *
1114  ELSE IF( lsamen( 2, c2, 'SP' ) ) THEN
1115 *
1116 * CSPSV
1117 *
1118  srnamt = 'CSPSV '
1119  infot = 1
1120  CALL cspsv( '/', 0, 0, a, ip, b, 1, info )
1121  CALL chkxer( 'CSPSV ', infot, nout, lerr, ok )
1122  infot = 2
1123  CALL cspsv( 'U', -1, 0, a, ip, b, 1, info )
1124  CALL chkxer( 'CSPSV ', infot, nout, lerr, ok )
1125  infot = 3
1126  CALL cspsv( 'U', 0, -1, a, ip, b, 1, info )
1127  CALL chkxer( 'CSPSV ', infot, nout, lerr, ok )
1128  infot = 7
1129  CALL cspsv( 'U', 2, 0, a, ip, b, 1, info )
1130  CALL chkxer( 'CSPSV ', infot, nout, lerr, ok )
1131 *
1132 * CSPSVX
1133 *
1134  srnamt = 'CSPSVX'
1135  infot = 1
1136  CALL cspsvx( '/', 'U', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
1137  $ r2, w, rw, info )
1138  CALL chkxer( 'CSPSVX', infot, nout, lerr, ok )
1139  infot = 2
1140  CALL cspsvx( 'N', '/', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
1141  $ r2, w, rw, info )
1142  CALL chkxer( 'CSPSVX', infot, nout, lerr, ok )
1143  infot = 3
1144  CALL cspsvx( 'N', 'U', -1, 0, a, af, ip, b, 1, x, 1, rcond, r1,
1145  $ r2, w, rw, info )
1146  CALL chkxer( 'CSPSVX', infot, nout, lerr, ok )
1147  infot = 4
1148  CALL cspsvx( 'N', 'U', 0, -1, a, af, ip, b, 1, x, 1, rcond, r1,
1149  $ r2, w, rw, info )
1150  CALL chkxer( 'CSPSVX', infot, nout, lerr, ok )
1151  infot = 9
1152  CALL cspsvx( 'N', 'U', 2, 0, a, af, ip, b, 1, x, 2, rcond, r1,
1153  $ r2, w, rw, info )
1154  CALL chkxer( 'CSPSVX', infot, nout, lerr, ok )
1155  infot = 11
1156  CALL cspsvx( 'N', 'U', 2, 0, a, af, ip, b, 2, x, 1, rcond, r1,
1157  $ r2, w, rw, info )
1158  CALL chkxer( 'CSPSVX', infot, nout, lerr, ok )
1159  END IF
1160 *
1161 * Print a summary line.
1162 *
1163  IF( ok ) THEN
1164  WRITE( nout, fmt = 9999 )path
1165  ELSE
1166  WRITE( nout, fmt = 9998 )path
1167  END IF
1168 *
1169  9999 FORMAT( 1x, a3, ' drivers passed the tests of the error exits' )
1170  9998 FORMAT( ' *** ', a3, ' drivers failed the tests of the error ',
1171  $ 'exits ***' )
1172 *
1173  RETURN
1174 *
1175 * End of CERRVX
1176 *
1177  END
subroutine chpsv(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
CHPSV computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: chpsv.f:164
subroutine cgtsv(N, NRHS, DL, D, DU, B, LDB, INFO)
CGTSV computes the solution to system of linear equations A * X = B for GT matrices ...
Definition: cgtsv.f:126
subroutine cgbsv(N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
CGBSV computes the solution to system of linear equations A * X = B for GB matrices (simple driver) ...
Definition: cgbsv.f:164
subroutine cspsv(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
CSPSV computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: cspsv.f:164
subroutine cposvxx(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, RWORK, INFO)
CPOSVXX computes the solution to system of linear equations A * X = B for PO matrices ...
Definition: cposvxx.f:498
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
subroutine cerrvx(PATH, NUNIT)
CERRVX
Definition: cerrvx.f:57
subroutine chesv(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CHESV computes the solution to system of linear equations A * X = B for HE matrices ...
Definition: chesv.f:173
subroutine chesvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, RWORK, INFO)
CHESVX computes the solution to system of linear equations A * X = B for HE matrices ...
Definition: chesvx.f:287
subroutine cgtsvx(FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CGTSVX computes the solution to system of linear equations A * X = B for GT matrices ...
Definition: cgtsvx.f:296
subroutine cptsv(N, NRHS, D, E, B, LDB, INFO)
CPTSV computes the solution to system of linear equations A * X = B for PT matrices ...
Definition: cptsv.f:117
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
subroutine csysv_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: csysv_rook.f:206
subroutine cspsvx(FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: cspsvx.f:279
subroutine csysvxx(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, RWORK, INFO)
CSYSVXX computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: csysvxx.f:511
subroutine cgesvx(FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CGESVX computes the solution to system of linear equations A * X = B for GE matrices ...
Definition: cgesvx.f:352
subroutine cppsvx(FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: cppsvx.f:313
subroutine cgbsvx(FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CGBSVX computes the solution to system of linear equations A * X = B for GB matrices ...
Definition: cgbsvx.f:372
subroutine cgbsvxx(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, RWORK, INFO)
CGBSVXX computes the solution to system of linear equations A * X = B for GB matrices ...
Definition: cgbsvxx.f:565
subroutine cpbsv(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
CPBSV computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: cpbsv.f:166
subroutine csysvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, RWORK, INFO)
CSYSVX computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: csysvx.f:287
subroutine cpbsvx(FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: cpbsvx.f:344
subroutine cposvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CPOSVX computes the solution to system of linear equations A * X = B for PO matrices ...
Definition: cposvx.f:308
subroutine csysv(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CSYSV computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: csysv.f:173
subroutine cposv(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
CPOSV computes the solution to system of linear equations A * X = B for PO matrices ...
Definition: cposv.f:132
subroutine cptsvx(FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CPTSVX computes the solution to system of linear equations A * X = B for PT matrices ...
Definition: cptsvx.f:236
subroutine cgesv(N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CGESV computes the solution to system of linear equations A * X = B for GE matrices (simple driver) ...
Definition: cgesv.f:124
subroutine cgesvxx(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, RWORK, INFO)
CGESVXX computes the solution to system of linear equations A * X = B for GE matrices ...
Definition: cgesvxx.f:545
subroutine chesvxx(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, RWORK, INFO)
CHESVXX computes the solution to system of linear equations A * X = B for HE matrices ...
Definition: chesvxx.f:511
subroutine cppsv(UPLO, N, NRHS, AP, B, LDB, INFO)
CPPSV computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: cppsv.f:146
subroutine chesv_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CHESV_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using the ...
Definition: chesv_rook.f:207
subroutine chpsvx(FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CHPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: chpsvx.f:279