LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
zerrvxx.f
Go to the documentation of this file.
1*> \brief \b ZERRVXX
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 ZERRVX( 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*> ZERRVX tests the error exits for the COMPLEX*16 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*> \ingroup complex16_lin
52*
53* =====================================================================
54 SUBROUTINE zerrvx( PATH, NUNIT )
55*
56* -- LAPACK test routine --
57* -- LAPACK is a software package provided by Univ. of Tennessee, --
58* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59*
60* .. Scalar Arguments ..
61 CHARACTER*3 PATH
62 INTEGER NUNIT
63* ..
64*
65* =====================================================================
66*
67* .. Parameters ..
68 INTEGER NMAX
69 parameter( nmax = 4 )
70 REAL ONE
71 parameter( one = 1.0d+0 )
72* ..
73* .. Local Scalars ..
74 CHARACTER EQ
75 CHARACTER*2 C2
76 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
77 DOUBLE PRECISION RCOND, RPVGRW, BERR
78* ..
79* .. Local Arrays ..
80 INTEGER IP( NMAX )
81 DOUBLE PRECISION C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
82 $ RF( NMAX ), RW( NMAX ), ERR_BNDS_N( NMAX, 3 ),
83 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
84 COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
85 $ E( NMAX ), W( 2*NMAX ), X( NMAX )
86* ..
87* .. External Functions ..
88 LOGICAL LSAMEN
89 EXTERNAL lsamen
90* ..
91* .. External Subroutines ..
92 EXTERNAL chkxer, zgbsv, zgbsvx, zgesv, zgesvx, zgtsv,
98* ..
99* .. Scalars in Common ..
100 LOGICAL LERR, OK
101 CHARACTER*32 SRNAMT
102 INTEGER INFOT, NOUT
103* ..
104* .. Common blocks ..
105 COMMON / infoc / infot, nout, ok, lerr
106 COMMON / srnamc / srnamt
107* ..
108* .. Intrinsic Functions ..
109 INTRINSIC dble, dcmplx
110* ..
111* .. Executable Statements ..
112*
113 nout = nunit
114 WRITE( nout, fmt = * )
115 c2 = path( 2: 3 )
116*
117* Set the variables to innocuous values.
118*
119 DO 20 j = 1, nmax
120 DO 10 i = 1, nmax
121 a( i, j ) = dcmplx( 1.d0 / dble( i+j ),
122 $ -1.d0 / dble( i+j ) )
123 af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
124 $ -1.d0 / dble( i+j ) )
125 10 CONTINUE
126 b( j ) = 0.d0
127 e( j ) = 0.d0
128 r1( j ) = 0.d0
129 r2( j ) = 0.d0
130 w( j ) = 0.d0
131 x( j ) = 0.d0
132 c( j ) = 0.d0
133 r( j ) = 0.d0
134 ip( j ) = j
135 20 CONTINUE
136 eq = ' '
137 ok = .true.
138*
139 IF( lsamen( 2, c2, 'GE' ) ) THEN
140*
141* ZGESV
142*
143 srnamt = 'ZGESV '
144 infot = 1
145 CALL zgesv( -1, 0, a, 1, ip, b, 1, info )
146 CALL chkxer( 'ZGESV ', infot, nout, lerr, ok )
147 infot = 2
148 CALL zgesv( 0, -1, a, 1, ip, b, 1, info )
149 CALL chkxer( 'ZGESV ', infot, nout, lerr, ok )
150 infot = 4
151 CALL zgesv( 2, 1, a, 1, ip, b, 2, info )
152 CALL chkxer( 'ZGESV ', infot, nout, lerr, ok )
153 infot = 7
154 CALL zgesv( 2, 1, a, 2, ip, b, 1, info )
155 CALL chkxer( 'ZGESV ', infot, nout, lerr, ok )
156*
157* ZGESVX
158*
159 srnamt = 'ZGESVX'
160 infot = 1
161 CALL zgesvx( '/', '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( 'ZGESVX', infot, nout, lerr, ok )
164 infot = 2
165 CALL zgesvx( '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( 'ZGESVX', infot, nout, lerr, ok )
168 infot = 3
169 CALL zgesvx( '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( 'ZGESVX', infot, nout, lerr, ok )
172 infot = 4
173 CALL zgesvx( '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( 'ZGESVX', infot, nout, lerr, ok )
176 infot = 6
177 CALL zgesvx( '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( 'ZGESVX', infot, nout, lerr, ok )
180 infot = 8
181 CALL zgesvx( '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( 'ZGESVX', infot, nout, lerr, ok )
184 infot = 10
185 eq = '/'
186 CALL zgesvx( '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( 'ZGESVX', infot, nout, lerr, ok )
189 infot = 11
190 eq = 'R'
191 CALL zgesvx( '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( 'ZGESVX', infot, nout, lerr, ok )
194 infot = 12
195 eq = 'C'
196 CALL zgesvx( '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( 'ZGESVX', infot, nout, lerr, ok )
199 infot = 14
200 CALL zgesvx( '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( 'ZGESVX', infot, nout, lerr, ok )
203 infot = 16
204 CALL zgesvx( '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( 'ZGESVX', infot, nout, lerr, ok )
207*
208* ZGESVXX
209*
210 n_err_bnds = 3
211 nparams = 1
212 srnamt = 'ZGESVXX'
213 infot = 1
214 CALL zgesvxx( '/', 'N', 0, 0, a, 1, af, 1, ip, eq, r, c, b,
215 $ 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
216 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
217 $ info )
218 CALL chkxer( 'ZGESVXX', infot, nout, lerr, ok )
219 infot = 2
220 CALL zgesvxx( 'N', '/', 0, 0, a, 1, af, 1, ip, eq, r, c, b,
221 $ 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
222 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
223 $ info )
224 CALL chkxer( 'ZGESVXX', infot, nout, lerr, ok )
225 infot = 3
226 CALL zgesvxx( 'N', 'N', -1, 0, a, 1, af, 1, ip, eq, r, c, b,
227 $ 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
228 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
229 $ info )
230 CALL chkxer( 'ZGESVXX', infot, nout, lerr, ok )
231 infot = 4
232 CALL zgesvxx( 'N', 'N', 0, -1, a, 1, af, 1, ip, eq, r, c, b,
233 $ 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
234 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
235 $ info )
236 CALL chkxer( 'ZGESVXX', infot, nout, lerr, ok )
237 infot = 6
238 CALL zgesvxx( 'N', 'N', 2, 1, a, 1, af, 2, ip, eq, r, c, b,
239 $ 2, x, 2, rcond, rpvgrw, berr, n_err_bnds,
240 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
241 $ info )
242 CALL chkxer( 'ZGESVXX', infot, nout, lerr, ok )
243 infot = 8
244 CALL zgesvxx( 'N', 'N', 2, 1, a, 2, af, 1, ip, eq, r, c, b,
245 $ 2, x, 2, rcond, rpvgrw, berr, n_err_bnds,
246 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
247 $ info )
248 CALL chkxer( 'ZGESVXX', infot, nout, lerr, ok )
249 infot = 10
250 eq = '/'
251 CALL zgesvxx( 'F', 'N', 0, 0, a, 1, af, 1, ip, eq, r, c, b,
252 $ 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
253 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
254 $ info )
255 CALL chkxer( 'ZGESVXX', infot, nout, lerr, ok )
256 infot = 11
257 eq = 'R'
258 CALL zgesvxx( 'F', 'N', 1, 0, a, 1, af, 1, ip, eq, r, c, b,
259 $ 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
260 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
261 $ info )
262 CALL chkxer( 'ZGESVXX', infot, nout, lerr, ok )
263 infot = 12
264 eq = 'C'
265 CALL zgesvxx( 'F', 'N', 1, 0, a, 1, af, 1, ip, eq, r, c, b,
266 $ 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
267 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
268 $ info )
269 CALL chkxer( 'ZGESVXX', infot, nout, lerr, ok )
270 infot = 14
271 CALL zgesvxx( 'N', 'N', 2, 1, a, 2, af, 2, ip, eq, r, c, b,
272 $ 1, x, 2, rcond, rpvgrw, berr, n_err_bnds,
273 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
274 $ info )
275 CALL chkxer( 'ZGESVXX', infot, nout, lerr, ok )
276 infot = 16
277 CALL zgesvxx( 'N', 'N', 2, 1, a, 2, af, 2, ip, eq, r, c, b,
278 $ 2, x, 1, rcond, rpvgrw, berr, n_err_bnds,
279 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
280 $ info )
281 CALL chkxer( 'ZGESVXX', infot, nout, lerr, ok )
282*
283 ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
284*
285* ZGBSV
286*
287 srnamt = 'ZGBSV '
288 infot = 1
289 CALL zgbsv( -1, 0, 0, 0, a, 1, ip, b, 1, info )
290 CALL chkxer( 'ZGBSV ', infot, nout, lerr, ok )
291 infot = 2
292 CALL zgbsv( 1, -1, 0, 0, a, 1, ip, b, 1, info )
293 CALL chkxer( 'ZGBSV ', infot, nout, lerr, ok )
294 infot = 3
295 CALL zgbsv( 1, 0, -1, 0, a, 1, ip, b, 1, info )
296 CALL chkxer( 'ZGBSV ', infot, nout, lerr, ok )
297 infot = 4
298 CALL zgbsv( 0, 0, 0, -1, a, 1, ip, b, 1, info )
299 CALL chkxer( 'ZGBSV ', infot, nout, lerr, ok )
300 infot = 6
301 CALL zgbsv( 1, 1, 1, 0, a, 3, ip, b, 1, info )
302 CALL chkxer( 'ZGBSV ', infot, nout, lerr, ok )
303 infot = 9
304 CALL zgbsv( 2, 0, 0, 0, a, 1, ip, b, 1, info )
305 CALL chkxer( 'ZGBSV ', infot, nout, lerr, ok )
306*
307* ZGBSVX
308*
309 srnamt = 'ZGBSVX'
310 infot = 1
311 CALL zgbsvx( '/', 'N', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
312 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
313 CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
314 infot = 2
315 CALL zgbsvx( 'N', '/', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
316 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
317 CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
318 infot = 3
319 CALL zgbsvx( 'N', 'N', -1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
320 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
321 CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
322 infot = 4
323 CALL zgbsvx( 'N', 'N', 1, -1, 0, 0, a, 1, af, 1, ip, eq, r, c,
324 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
325 CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
326 infot = 5
327 CALL zgbsvx( 'N', 'N', 1, 0, -1, 0, a, 1, af, 1, ip, eq, r, c,
328 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
329 CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
330 infot = 6
331 CALL zgbsvx( 'N', 'N', 0, 0, 0, -1, a, 1, af, 1, ip, eq, r, c,
332 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
333 CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
334 infot = 8
335 CALL zgbsvx( 'N', 'N', 1, 1, 1, 0, a, 2, af, 4, ip, eq, r, c,
336 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
337 CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
338 infot = 10
339 CALL zgbsvx( 'N', 'N', 1, 1, 1, 0, a, 3, af, 3, ip, eq, r, c,
340 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
341 CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
342 infot = 12
343 eq = '/'
344 CALL zgbsvx( 'F', 'N', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
345 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
346 CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
347 infot = 13
348 eq = 'R'
349 CALL zgbsvx( 'F', 'N', 1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
350 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
351 CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
352 infot = 14
353 eq = 'C'
354 CALL zgbsvx( 'F', 'N', 1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
355 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
356 CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
357 infot = 16
358 CALL zgbsvx( 'N', 'N', 2, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
359 $ b, 1, x, 2, rcond, r1, r2, w, rw, info )
360 CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
361 infot = 18
362 CALL zgbsvx( 'N', 'N', 2, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
363 $ b, 2, x, 1, rcond, r1, r2, w, rw, info )
364 CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
365*
366* ZGBSVXX
367*
368 n_err_bnds = 3
369 nparams = 1
370 srnamt = 'ZGBSVXX'
371 infot = 1
372 CALL zgbsvxx( '/', 'N', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
373 $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
374 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
375 $ info )
376 CALL chkxer( 'ZGBSVXX', infot, nout, lerr, ok )
377 infot = 2
378 CALL zgbsvxx( 'N', '/', 0, 1, 1, 0, a, 1, af, 1, ip, eq, r, c,
379 $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
380 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
381 $ info )
382 CALL chkxer( 'ZGBSVXX', infot, nout, lerr, ok )
383 infot = 3
384 CALL zgbsvxx( 'N', 'N', -1, 1, 1, 0, a, 1, af, 1, ip, eq, r, c,
385 $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
386 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
387 $ info )
388 CALL chkxer( 'ZGBSVXX', infot, nout, lerr, ok )
389 infot = 4
390 CALL zgbsvxx( 'N', 'N', 2, -1, 1, 0, a, 1, af, 1, ip, eq,
391 $ r, c, b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
392 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
393 $ info )
394 CALL chkxer( 'ZGBSVXX', infot, nout, lerr, ok )
395 infot = 5
396 CALL zgbsvxx( 'N', 'N', 2, 1, -1, 0, a, 1, af, 1, ip, eq,
397 $ r, c, b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
398 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
399 $ info )
400 CALL chkxer( 'ZGBSVXX', infot, nout, lerr, ok )
401 infot = 6
402 CALL zgbsvxx( 'N', 'N', 0, 1, 1, -1, a, 1, af, 1, ip, eq, r, c,
403 $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
404 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
405 $ info )
406 CALL chkxer( 'ZGBSVXX', infot, nout, lerr, ok )
407 infot = 8
408 CALL zgbsvxx( 'N', 'N', 2, 1, 1, 1, a, 2, af, 2, ip, eq, r, c,
409 $ b, 2, x, 2, rcond, rpvgrw, berr, n_err_bnds,
410 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
411 $ info )
412 CALL chkxer( 'ZGBSVXX', infot, nout, lerr, ok )
413 infot = 10
414 CALL zgbsvxx( 'N', 'N', 2, 1, 1, 1, a, 3, af, 3, ip, eq, r, c,
415 $ b, 2, x, 2, rcond, rpvgrw, berr, n_err_bnds,
416 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
417 $ info )
418 CALL chkxer( 'ZGBSVXX', infot, nout, lerr, ok )
419 infot = 12
420 eq = '/'
421 CALL zgbsvxx( 'F', 'N', 0, 1, 1, 0, a, 3, af, 4, ip, eq, r, c,
422 $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
423 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
424 $ info )
425 CALL chkxer( 'ZGBSVXX', infot, nout, lerr, ok )
426 infot = 13
427 eq = 'R'
428 CALL zgbsvxx( 'F', 'N', 1, 1, 1, 0, a, 3, af, 4, ip, eq, r, c,
429 $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
430 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
431 $ info )
432 CALL chkxer( 'ZGBSVXX', infot, nout, lerr, ok )
433 infot = 14
434 eq = 'C'
435 CALL zgbsvxx( 'F', 'N', 1, 1, 1, 0, a, 3, af, 4, ip, eq, r, c,
436 $ b, 1, x, 1, rcond, rpvgrw, berr, n_err_bnds,
437 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
438 $ info )
439 CALL chkxer( 'ZGBSVXX', infot, nout, lerr, ok )
440 infot = 15
441 CALL zgbsvxx( 'N', 'N', 2, 1, 1, 1, a, 3, af, 4, ip, eq, r, c,
442 $ b, 1, x, 2, rcond, rpvgrw, berr, n_err_bnds,
443 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
444 $ info )
445 CALL chkxer( 'ZGBSVXX', infot, nout, lerr, ok )
446 infot = 16
447 CALL zgbsvxx( 'N', 'N', 2, 1, 1, 1, a, 3, af, 4, ip, eq, r, c,
448 $ b, 2, x, 1, rcond, rpvgrw, berr, n_err_bnds,
449 $ err_bnds_n, err_bnds_c, nparams, params, w, rw,
450 $ info )
451 CALL chkxer( 'ZGBSVXX', infot, nout, lerr, ok )
452*
453 ELSE IF( lsamen( 2, c2, 'GT' ) ) THEN
454*
455* ZGTSV
456*
457 srnamt = 'ZGTSV '
458 infot = 1
459 CALL zgtsv( -1, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1,
460 $ info )
461 CALL chkxer( 'ZGTSV ', infot, nout, lerr, ok )
462 infot = 2
463 CALL zgtsv( 0, -1, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1,
464 $ info )
465 CALL chkxer( 'ZGTSV ', infot, nout, lerr, ok )
466 infot = 7
467 CALL zgtsv( 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1, info )
468 CALL chkxer( 'ZGTSV ', infot, nout, lerr, ok )
469*
470* ZGTSVX
471*
472 srnamt = 'ZGTSVX'
473 infot = 1
474 CALL zgtsvx( '/', 'N', 0, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
475 $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
476 $ ip, b, 1, x, 1, rcond, r1, r2, w, rw, info )
477 CALL chkxer( 'ZGTSVX', infot, nout, lerr, ok )
478 infot = 2
479 CALL zgtsvx( 'N', '/', 0, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
480 $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
481 $ ip, b, 1, x, 1, rcond, r1, r2, w, rw, info )
482 CALL chkxer( 'ZGTSVX', infot, nout, lerr, ok )
483 infot = 3
484 CALL zgtsvx( 'N', 'N', -1, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
485 $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
486 $ ip, b, 1, x, 1, rcond, r1, r2, w, rw, info )
487 CALL chkxer( 'ZGTSVX', infot, nout, lerr, ok )
488 infot = 4
489 CALL zgtsvx( 'N', 'N', 0, -1, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
490 $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
491 $ ip, b, 1, x, 1, rcond, r1, r2, w, rw, info )
492 CALL chkxer( 'ZGTSVX', infot, nout, lerr, ok )
493 infot = 14
494 CALL zgtsvx( 'N', 'N', 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
495 $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
496 $ ip, b, 1, x, 2, rcond, r1, r2, w, rw, info )
497 CALL chkxer( 'ZGTSVX', infot, nout, lerr, ok )
498 infot = 16
499 CALL zgtsvx( 'N', 'N', 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
500 $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
501 $ ip, b, 2, x, 1, rcond, r1, r2, w, rw, info )
502 CALL chkxer( 'ZGTSVX', infot, nout, lerr, ok )
503*
504 ELSE IF( lsamen( 2, c2, 'HR' ) ) THEN
505*
506* ZHESV_ROOK
507*
508 srnamt = 'ZHESV_ROOK'
509 infot = 1
510 CALL zhesv_rook( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
511 CALL chkxer( 'ZHESV_ROOK', infot, nout, lerr, ok )
512 infot = 2
513 CALL zhesv_rook( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
514 CALL chkxer( 'ZHESV_ROOK', infot, nout, lerr, ok )
515 infot = 3
516 CALL zhesv_rook( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
517 CALL chkxer( 'ZHESV_ROOK', infot, nout, lerr, ok )
518 infot = 8
519 CALL zhesv_rook( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
520 CALL chkxer( 'ZHESV_ROOK', infot, nout, lerr, ok )
521*
522 ELSE IF( lsamen( 2, c2, 'PO' ) ) THEN
523*
524* ZPOSV
525*
526 srnamt = 'ZPOSV '
527 infot = 1
528 CALL zposv( '/', 0, 0, a, 1, b, 1, info )
529 CALL chkxer( 'ZPOSV ', infot, nout, lerr, ok )
530 infot = 2
531 CALL zposv( 'U', -1, 0, a, 1, b, 1, info )
532 CALL chkxer( 'ZPOSV ', infot, nout, lerr, ok )
533 infot = 3
534 CALL zposv( 'U', 0, -1, a, 1, b, 1, info )
535 CALL chkxer( 'ZPOSV ', infot, nout, lerr, ok )
536 infot = 5
537 CALL zposv( 'U', 2, 0, a, 1, b, 2, info )
538 CALL chkxer( 'ZPOSV ', infot, nout, lerr, ok )
539 infot = 7
540 CALL zposv( 'U', 2, 0, a, 2, b, 1, info )
541 CALL chkxer( 'ZPOSV ', infot, nout, lerr, ok )
542*
543* ZPOSVX
544*
545 srnamt = 'ZPOSVX'
546 infot = 1
547 CALL zposvx( '/', 'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
548 $ rcond, r1, r2, w, rw, info )
549 CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
550 infot = 2
551 CALL zposvx( 'N', '/', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
552 $ rcond, r1, r2, w, rw, info )
553 CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
554 infot = 3
555 CALL zposvx( 'N', 'U', -1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
556 $ rcond, r1, r2, w, rw, info )
557 CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
558 infot = 4
559 CALL zposvx( 'N', 'U', 0, -1, a, 1, af, 1, eq, c, b, 1, x, 1,
560 $ rcond, r1, r2, w, rw, info )
561 CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
562 infot = 6
563 CALL zposvx( 'N', 'U', 2, 0, a, 1, af, 2, eq, c, b, 2, x, 2,
564 $ rcond, r1, r2, w, rw, info )
565 CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
566 infot = 8
567 CALL zposvx( 'N', 'U', 2, 0, a, 2, af, 1, eq, c, b, 2, x, 2,
568 $ rcond, r1, r2, w, rw, info )
569 CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
570 infot = 9
571 eq = '/'
572 CALL zposvx( 'F', 'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
573 $ rcond, r1, r2, w, rw, info )
574 CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
575 infot = 10
576 eq = 'Y'
577 CALL zposvx( 'F', 'U', 1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
578 $ rcond, r1, r2, w, rw, info )
579 CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
580 infot = 12
581 CALL zposvx( 'N', 'U', 2, 0, a, 2, af, 2, eq, c, b, 1, x, 2,
582 $ rcond, r1, r2, w, rw, info )
583 CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
584 infot = 14
585 CALL zposvx( 'N', 'U', 2, 0, a, 2, af, 2, eq, c, b, 2, x, 1,
586 $ rcond, r1, r2, w, rw, info )
587 CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
588*
589* ZPOSVXX
590*
591 n_err_bnds = 3
592 nparams = 1
593 srnamt = 'ZPOSVXX'
594 infot = 1
595 CALL zposvxx( '/', '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, rw, info )
598 CALL chkxer( 'ZPOSVXX', infot, nout, lerr, ok )
599 infot = 2
600 CALL zposvxx( 'N', '/', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
601 $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
602 $ err_bnds_c, nparams, params, w, rw, info )
603 CALL chkxer( 'ZPOSVXX', infot, nout, lerr, ok )
604 infot = 3
605 CALL zposvxx( 'N', 'U', -1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
606 $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
607 $ err_bnds_c, nparams, params, w, rw, info )
608 CALL chkxer( 'ZPOSVXX', infot, nout, lerr, ok )
609 infot = 4
610 CALL zposvxx( 'N', 'U', 0, -1, a, 1, af, 1, eq, c, b, 1, x, 1,
611 $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
612 $ err_bnds_c, nparams, params, w, rw, info )
613 CALL chkxer( 'ZPOSVXX', infot, nout, lerr, ok )
614 infot = 6
615 CALL zposvxx( 'N', 'U', 2, 0, a, 1, af, 2, eq, c, b, 2, x, 2,
616 $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
617 $ err_bnds_c, nparams, params, w, rw, info )
618 CALL chkxer( 'ZPOSVXX', infot, nout, lerr, ok )
619 infot = 8
620 CALL zposvxx( 'N', 'U', 2, 0, a, 2, af, 1, eq, c, b, 2, x, 2,
621 $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
622 $ err_bnds_c, nparams, params, w, rw, info )
623 CALL chkxer( 'ZPOSVXX', infot, nout, lerr, ok )
624 infot = 9
625 eq = '/'
626 CALL zposvxx( 'F', 'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
627 $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
628 $ err_bnds_c, nparams, params, w, rw, info )
629 CALL chkxer( 'ZPOSVXX', infot, nout, lerr, ok )
630 infot = 10
631 eq = 'Y'
632 CALL zposvxx( 'F', 'U', 1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
633 $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
634 $ err_bnds_c, nparams, params, w, rw, info )
635 CALL chkxer( 'ZPOSVXX', infot, nout, lerr, ok )
636 infot = 12
637 CALL zposvxx( 'N', 'U', 2, 0, a, 2, af, 2, eq, c, b, 1, x, 2,
638 $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
639 $ err_bnds_c, nparams, params, w, rw, info )
640 CALL chkxer( 'ZPOSVXX', infot, nout, lerr, ok )
641 infot = 14
642 CALL zposvxx( 'N', 'U', 2, 0, a, 2, af, 2, eq, c, b, 2, x, 1,
643 $ rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
644 $ err_bnds_c, nparams, params, w, rw, info )
645 CALL chkxer( 'ZPOSVXX', infot, nout, lerr, ok )
646*
647 ELSE IF( lsamen( 2, c2, 'PP' ) ) THEN
648*
649* ZPPSV
650*
651 srnamt = 'ZPPSV '
652 infot = 1
653 CALL zppsv( '/', 0, 0, a, b, 1, info )
654 CALL chkxer( 'ZPPSV ', infot, nout, lerr, ok )
655 infot = 2
656 CALL zppsv( 'U', -1, 0, a, b, 1, info )
657 CALL chkxer( 'ZPPSV ', infot, nout, lerr, ok )
658 infot = 3
659 CALL zppsv( 'U', 0, -1, a, b, 1, info )
660 CALL chkxer( 'ZPPSV ', infot, nout, lerr, ok )
661 infot = 6
662 CALL zppsv( 'U', 2, 0, a, b, 1, info )
663 CALL chkxer( 'ZPPSV ', infot, nout, lerr, ok )
664*
665* ZPPSVX
666*
667 srnamt = 'ZPPSVX'
668 infot = 1
669 CALL zppsvx( '/', 'U', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
670 $ r1, r2, w, rw, info )
671 CALL chkxer( 'ZPPSVX', infot, nout, lerr, ok )
672 infot = 2
673 CALL zppsvx( 'N', '/', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
674 $ r1, r2, w, rw, info )
675 CALL chkxer( 'ZPPSVX', infot, nout, lerr, ok )
676 infot = 3
677 CALL zppsvx( 'N', 'U', -1, 0, a, af, eq, c, b, 1, x, 1, rcond,
678 $ r1, r2, w, rw, info )
679 CALL chkxer( 'ZPPSVX', infot, nout, lerr, ok )
680 infot = 4
681 CALL zppsvx( 'N', 'U', 0, -1, a, af, eq, c, b, 1, x, 1, rcond,
682 $ r1, r2, w, rw, info )
683 CALL chkxer( 'ZPPSVX', infot, nout, lerr, ok )
684 infot = 7
685 eq = '/'
686 CALL zppsvx( 'F', 'U', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
687 $ r1, r2, w, rw, info )
688 CALL chkxer( 'ZPPSVX', infot, nout, lerr, ok )
689 infot = 8
690 eq = 'Y'
691 CALL zppsvx( 'F', 'U', 1, 0, a, af, eq, c, b, 1, x, 1, rcond,
692 $ r1, r2, w, rw, info )
693 CALL chkxer( 'ZPPSVX', infot, nout, lerr, ok )
694 infot = 10
695 CALL zppsvx( 'N', 'U', 2, 0, a, af, eq, c, b, 1, x, 2, rcond,
696 $ r1, r2, w, rw, info )
697 CALL chkxer( 'ZPPSVX', infot, nout, lerr, ok )
698 infot = 12
699 CALL zppsvx( 'N', 'U', 2, 0, a, af, eq, c, b, 2, x, 1, rcond,
700 $ r1, r2, w, rw, info )
701 CALL chkxer( 'ZPPSVX', infot, nout, lerr, ok )
702*
703 ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
704*
705* ZPBSV
706*
707 srnamt = 'ZPBSV '
708 infot = 1
709 CALL zpbsv( '/', 0, 0, 0, a, 1, b, 1, info )
710 CALL chkxer( 'ZPBSV ', infot, nout, lerr, ok )
711 infot = 2
712 CALL zpbsv( 'U', -1, 0, 0, a, 1, b, 1, info )
713 CALL chkxer( 'ZPBSV ', infot, nout, lerr, ok )
714 infot = 3
715 CALL zpbsv( 'U', 1, -1, 0, a, 1, b, 1, info )
716 CALL chkxer( 'ZPBSV ', infot, nout, lerr, ok )
717 infot = 4
718 CALL zpbsv( 'U', 0, 0, -1, a, 1, b, 1, info )
719 CALL chkxer( 'ZPBSV ', infot, nout, lerr, ok )
720 infot = 6
721 CALL zpbsv( 'U', 1, 1, 0, a, 1, b, 2, info )
722 CALL chkxer( 'ZPBSV ', infot, nout, lerr, ok )
723 infot = 8
724 CALL zpbsv( 'U', 2, 0, 0, a, 1, b, 1, info )
725 CALL chkxer( 'ZPBSV ', infot, nout, lerr, ok )
726*
727* ZPBSVX
728*
729 srnamt = 'ZPBSVX'
730 infot = 1
731 CALL zpbsvx( '/', 'U', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
732 $ rcond, r1, r2, w, rw, info )
733 CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
734 infot = 2
735 CALL zpbsvx( 'N', '/', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
736 $ rcond, r1, r2, w, rw, info )
737 CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
738 infot = 3
739 CALL zpbsvx( 'N', 'U', -1, 0, 0, a, 1, af, 1, eq, c, b, 1, x,
740 $ 1, rcond, r1, r2, w, rw, info )
741 CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
742 infot = 4
743 CALL zpbsvx( 'N', 'U', 1, -1, 0, a, 1, af, 1, eq, c, b, 1, x,
744 $ 1, rcond, r1, r2, w, rw, info )
745 CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
746 infot = 5
747 CALL zpbsvx( 'N', 'U', 0, 0, -1, a, 1, af, 1, eq, c, b, 1, x,
748 $ 1, rcond, r1, r2, w, rw, info )
749 CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
750 infot = 7
751 CALL zpbsvx( 'N', 'U', 1, 1, 0, a, 1, af, 2, eq, c, b, 2, x, 2,
752 $ rcond, r1, r2, w, rw, info )
753 CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
754 infot = 9
755 CALL zpbsvx( 'N', 'U', 1, 1, 0, a, 2, af, 1, eq, c, b, 2, x, 2,
756 $ rcond, r1, r2, w, rw, info )
757 CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
758 infot = 10
759 eq = '/'
760 CALL zpbsvx( 'F', 'U', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
761 $ rcond, r1, r2, w, rw, info )
762 CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
763 infot = 11
764 eq = 'Y'
765 CALL zpbsvx( 'F', 'U', 1, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
766 $ rcond, r1, r2, w, rw, info )
767 CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
768 infot = 13
769 CALL zpbsvx( 'N', 'U', 2, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 2,
770 $ rcond, r1, r2, w, rw, info )
771 CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
772 infot = 15
773 CALL zpbsvx( 'N', 'U', 2, 0, 0, a, 1, af, 1, eq, c, b, 2, x, 1,
774 $ rcond, r1, r2, w, rw, info )
775 CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
776*
777 ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
778*
779* ZPTSV
780*
781 srnamt = 'ZPTSV '
782 infot = 1
783 CALL zptsv( -1, 0, r, a( 1, 1 ), b, 1, info )
784 CALL chkxer( 'ZPTSV ', infot, nout, lerr, ok )
785 infot = 2
786 CALL zptsv( 0, -1, r, a( 1, 1 ), b, 1, info )
787 CALL chkxer( 'ZPTSV ', infot, nout, lerr, ok )
788 infot = 6
789 CALL zptsv( 2, 0, r, a( 1, 1 ), b, 1, info )
790 CALL chkxer( 'ZPTSV ', infot, nout, lerr, ok )
791*
792* ZPTSVX
793*
794 srnamt = 'ZPTSVX'
795 infot = 1
796 CALL zptsvx( '/', 0, 0, r, a( 1, 1 ), rf, af( 1, 1 ), b, 1, x,
797 $ 1, rcond, r1, r2, w, rw, info )
798 CALL chkxer( 'ZPTSVX', infot, nout, lerr, ok )
799 infot = 2
800 CALL zptsvx( 'N', -1, 0, r, a( 1, 1 ), rf, af( 1, 1 ), b, 1, x,
801 $ 1, rcond, r1, r2, w, rw, info )
802 CALL chkxer( 'ZPTSVX', infot, nout, lerr, ok )
803 infot = 3
804 CALL zptsvx( 'N', 0, -1, r, a( 1, 1 ), rf, af( 1, 1 ), b, 1, x,
805 $ 1, rcond, r1, r2, w, rw, info )
806 CALL chkxer( 'ZPTSVX', infot, nout, lerr, ok )
807 infot = 9
808 CALL zptsvx( 'N', 2, 0, r, a( 1, 1 ), rf, af( 1, 1 ), b, 1, x,
809 $ 2, rcond, r1, r2, w, rw, info )
810 CALL chkxer( 'ZPTSVX', infot, nout, lerr, ok )
811 infot = 11
812 CALL zptsvx( 'N', 2, 0, r, a( 1, 1 ), rf, af( 1, 1 ), b, 2, x,
813 $ 1, rcond, r1, r2, w, rw, info )
814 CALL chkxer( 'ZPTSVX', infot, nout, lerr, ok )
815*
816 ELSE IF( lsamen( 2, c2, 'HE' ) ) THEN
817*
818* ZHESV
819*
820 srnamt = 'ZHESV '
821 infot = 1
822 CALL zhesv( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
823 CALL chkxer( 'ZHESV ', infot, nout, lerr, ok )
824 infot = 2
825 CALL zhesv( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
826 CALL chkxer( 'ZHESV ', infot, nout, lerr, ok )
827 infot = 3
828 CALL zhesv( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
829 CALL chkxer( 'ZHESV ', infot, nout, lerr, ok )
830 infot = 5
831 CALL zhesv( 'U', 2, 0, a, 1, ip, b, 2, w, 1, info )
832 CALL chkxer( 'ZHESV ', infot, nout, lerr, ok )
833 infot = 8
834 CALL zhesv( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
835 CALL chkxer( 'ZHESV ', infot, nout, lerr, ok )
836 infot = 10
837 CALL zhesv( 'U', 0, 0, a, 1, ip, b, 1, w, 0, info )
838 CALL chkxer( 'ZHESV ', infot, nout, lerr, ok )
839 infot = 10
840 CALL zhesv( 'U', 0, 0, a, 1, ip, b, 1, w, -2, info )
841 CALL chkxer( 'ZHESV ', infot, nout, lerr, ok )
842*
843* ZHESVX
844*
845 srnamt = 'ZHESVX'
846 infot = 1
847 CALL zhesvx( '/', 'U', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
848 $ rcond, r1, r2, w, 1, rw, info )
849 CALL chkxer( 'ZHESVX', infot, nout, lerr, ok )
850 infot = 2
851 CALL zhesvx( 'N', '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
852 $ rcond, r1, r2, w, 1, rw, info )
853 CALL chkxer( 'ZHESVX', infot, nout, lerr, ok )
854 infot = 3
855 CALL zhesvx( 'N', 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1,
856 $ rcond, r1, r2, w, 1, rw, info )
857 CALL chkxer( 'ZHESVX', infot, nout, lerr, ok )
858 infot = 4
859 CALL zhesvx( 'N', 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1,
860 $ rcond, r1, r2, w, 1, rw, info )
861 CALL chkxer( 'ZHESVX', infot, nout, lerr, ok )
862 infot = 6
863 CALL zhesvx( 'N', 'U', 2, 0, a, 1, af, 2, ip, b, 2, x, 2,
864 $ rcond, r1, r2, w, 4, rw, info )
865 CALL chkxer( 'ZHESVX', infot, nout, lerr, ok )
866 infot = 8
867 CALL zhesvx( 'N', 'U', 2, 0, a, 2, af, 1, ip, b, 2, x, 2,
868 $ rcond, r1, r2, w, 4, rw, info )
869 CALL chkxer( 'ZHESVX', infot, nout, lerr, ok )
870 infot = 11
871 CALL zhesvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 1, x, 2,
872 $ rcond, r1, r2, w, 4, rw, info )
873 CALL chkxer( 'ZHESVX', infot, nout, lerr, ok )
874 infot = 13
875 CALL zhesvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 1,
876 $ rcond, r1, r2, w, 4, rw, info )
877 CALL chkxer( 'ZHESVX', infot, nout, lerr, ok )
878 infot = 18
879 CALL zhesvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 2,
880 $ rcond, r1, r2, w, 3, rw, info )
881 CALL chkxer( 'ZHESVX', infot, nout, lerr, ok )
882*
883* ZHESVXX
884*
885 n_err_bnds = 3
886 nparams = 1
887 srnamt = 'ZHESVXX'
888 infot = 1
889 CALL zhesvxx( '/', 'U', 0, 0, a, 1, af, 1, ip, eq, c, b, 1, x,
890 $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
891 $ err_bnds_c, nparams, params, w, rw, info )
892 CALL chkxer( 'ZHESVXX', infot, nout, lerr, ok )
893 infot = 2
894 CALL zhesvxx( 'N', '/', 0, 0, a, 1, af, 1, ip, eq, c, b, 1, x,
895 $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
896 $ err_bnds_c, nparams, params, w, rw, info )
897 CALL chkxer( 'ZHESVXX', infot, nout, lerr, ok )
898 infot = 3
899 CALL zhesvxx( 'N', 'U', -1, 0, a, 1, af, 1, ip, eq, c, b, 1, x,
900 $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
901 $ err_bnds_c, nparams, params, w, rw, info )
902 CALL chkxer( 'ZHESVXX', infot, nout, lerr, ok )
903 infot = 4
904 CALL zhesvxx( 'N', 'U', 0, -1, a, 1, af, 1, ip, eq, c, b, 1, x,
905 $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
906 $ err_bnds_c, nparams, params, w, rw, info )
907 CALL chkxer( 'ZHESVXX', infot, nout, lerr, ok )
908 infot = 6
909 CALL zhesvxx( 'N', 'U', 2, 0, a, 1, af, 2, ip, eq, c, b, 2, x,
910 $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
911 $ err_bnds_c, nparams, params, w, rw, info )
912 CALL chkxer( 'ZHESVXX', infot, nout, lerr, ok )
913 infot = 8
914 CALL zhesvxx( 'N', 'U', 2, 0, a, 2, af, 1, ip, eq, c, b, 2, x,
915 $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
916 $ err_bnds_c, nparams, params, w, rw, info )
917 CALL chkxer( 'ZHESVXX', infot, nout, lerr, ok )
918 infot = 9
919 eq = '/'
920 CALL zhesvxx( 'F', 'U', 0, 0, a, 1, af, 1, ip, eq, c, b, 1, x,
921 $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
922 $ err_bnds_c, nparams, params, w, rw, info )
923 CALL chkxer( 'ZHESVXX', infot, nout, lerr, ok )
924 infot = 10
925 eq = 'Y'
926 CALL zhesvxx( 'F', 'U', 1, 0, a, 1, af, 1, ip, eq, c, b, 1, x,
927 $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
928 $ err_bnds_c, nparams, params, w, rw, info )
929 CALL chkxer( 'ZHESVXX', infot, nout, lerr, ok )
930 infot = 12
931 CALL zhesvxx( 'N', 'U', 2, 0, a, 2, af, 2, ip, eq, c, b, 1, x,
932 $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
933 $ err_bnds_c, nparams, params, w, rw, info )
934 CALL chkxer( 'ZHESVXX', infot, nout, lerr, ok )
935 infot = 14
936 CALL zhesvxx( 'N', 'U', 2, 0, a, 2, af, 2, ip, eq, c, b, 2, x,
937 $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
938 $ err_bnds_c, nparams, params, w, rw, info )
939 CALL chkxer( 'ZHESVXX', infot, nout, lerr, ok )
940*
941 ELSE IF( lsamen( 2, c2, 'HR' ) ) THEN
942*
943* ZHESV_ROOK
944*
945 srnamt = 'ZHESV_ROOK'
946 infot = 1
947 CALL zhesv_rook( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
948 CALL chkxer( 'ZHESV_ROOK', infot, nout, lerr, ok )
949 infot = 2
950 CALL zhesv_rook( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
951 CALL chkxer( 'ZHESV_ROOK', infot, nout, lerr, ok )
952 infot = 3
953 CALL zhesv_rook( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
954 CALL chkxer( 'ZHESV_ROOK', infot, nout, lerr, ok )
955 infot = 8
956 CALL zhesv_rook( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
957 CALL chkxer( 'ZHESV_ROOK', infot, nout, lerr, ok )
958 infot = 10
959 CALL zhesv_rook( 'U', 0, 0, a, 1, ip, b, 1, w, 0, info )
960 CALL chkxer( 'ZHESV_ROOK', infot, nout, lerr, ok )
961 infot = 10
962 CALL zhesv_rook( 'U', 0, 0, a, 1, ip, b, 1, w, -2, info )
963 CALL chkxer( 'ZHESV_ROOK', infot, nout, lerr, ok )
964*
965 ELSE IF( lsamen( 2, c2, 'HK' ) ) THEN
966*
967* ZSYSV_RK
968*
969* Test error exits of the driver that uses factorization
970* of a Hermitian indefinite matrix with rook
971* (bounded Bunch-Kaufman) pivoting with the new storage
972* format for factors L ( or U) and D.
973*
974* L (or U) is stored in A, diagonal of D is stored on the
975* diagonal of A, subdiagonal of D is stored in a separate array E.
976*
977 srnamt = 'ZHESV_RK'
978 infot = 1
979 CALL zhesv_rk( '/', 0, 0, a, 1, e, ip, b, 1, w, 1, info )
980 CALL chkxer( 'ZHESV_RK', infot, nout, lerr, ok )
981 infot = 2
982 CALL zhesv_rk( 'U', -1, 0, a, 1, e, ip, b, 1, w, 1, info )
983 CALL chkxer( 'ZHESV_RK', infot, nout, lerr, ok )
984 infot = 3
985 CALL zhesv_rk( 'U', 0, -1, a, 1, e, ip, b, 1, w, 1, info )
986 CALL chkxer( 'ZHESV_RK', infot, nout, lerr, ok )
987 infot = 5
988 CALL zhesv_rk( 'U', 2, 0, a, 1, e, ip, b, 2, w, 1, info )
989 CALL chkxer( 'ZHESV_RK', infot, nout, lerr, ok )
990 infot = 9
991 CALL zhesv_rk( 'U', 2, 0, a, 2, e, ip, b, 1, w, 1, info )
992 CALL chkxer( 'ZHESV_RK', infot, nout, lerr, ok )
993 infot = 11
994 CALL zhesv_rk( 'U', 0, 0, a, 1, e, ip, b, 1, w, 0, info )
995 CALL chkxer( 'ZHESV_RK', infot, nout, lerr, ok )
996 infot = 11
997 CALL zhesv_rk( 'U', 0, 0, a, 1, e, ip, b, 1, w, -2, info )
998 CALL chkxer( 'ZHESV_RK', infot, nout, lerr, ok )
999*
1000 ELSE IF( lsamen( 2, c2, 'HP' ) ) THEN
1001*
1002* ZHPSV
1003*
1004 srnamt = 'ZHPSV '
1005 infot = 1
1006 CALL zhpsv( '/', 0, 0, a, ip, b, 1, info )
1007 CALL chkxer( 'ZHPSV ', infot, nout, lerr, ok )
1008 infot = 2
1009 CALL zhpsv( 'U', -1, 0, a, ip, b, 1, info )
1010 CALL chkxer( 'ZHPSV ', infot, nout, lerr, ok )
1011 infot = 3
1012 CALL zhpsv( 'U', 0, -1, a, ip, b, 1, info )
1013 CALL chkxer( 'ZHPSV ', infot, nout, lerr, ok )
1014 infot = 7
1015 CALL zhpsv( 'U', 2, 0, a, ip, b, 1, info )
1016 CALL chkxer( 'ZHPSV ', infot, nout, lerr, ok )
1017*
1018* ZHPSVX
1019*
1020 srnamt = 'ZHPSVX'
1021 infot = 1
1022 CALL zhpsvx( '/', 'U', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
1023 $ r2, w, rw, info )
1024 CALL chkxer( 'ZHPSVX', infot, nout, lerr, ok )
1025 infot = 2
1026 CALL zhpsvx( 'N', '/', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
1027 $ r2, w, rw, info )
1028 CALL chkxer( 'ZHPSVX', infot, nout, lerr, ok )
1029 infot = 3
1030 CALL zhpsvx( 'N', 'U', -1, 0, a, af, ip, b, 1, x, 1, rcond, r1,
1031 $ r2, w, rw, info )
1032 CALL chkxer( 'ZHPSVX', infot, nout, lerr, ok )
1033 infot = 4
1034 CALL zhpsvx( 'N', 'U', 0, -1, a, af, ip, b, 1, x, 1, rcond, r1,
1035 $ r2, w, rw, info )
1036 CALL chkxer( 'ZHPSVX', infot, nout, lerr, ok )
1037 infot = 9
1038 CALL zhpsvx( 'N', 'U', 2, 0, a, af, ip, b, 1, x, 2, rcond, r1,
1039 $ r2, w, rw, info )
1040 CALL chkxer( 'ZHPSVX', infot, nout, lerr, ok )
1041 infot = 11
1042 CALL zhpsvx( 'N', 'U', 2, 0, a, af, ip, b, 2, x, 1, rcond, r1,
1043 $ r2, w, rw, info )
1044 CALL chkxer( 'ZHPSVX', infot, nout, lerr, ok )
1045*
1046 ELSE IF( lsamen( 2, c2, 'SY' ) ) THEN
1047*
1048* ZSYSV
1049*
1050 srnamt = 'ZSYSV '
1051 infot = 1
1052 CALL zsysv( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
1053 CALL chkxer( 'ZSYSV ', infot, nout, lerr, ok )
1054 infot = 2
1055 CALL zsysv( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
1056 CALL chkxer( 'ZSYSV ', infot, nout, lerr, ok )
1057 infot = 3
1058 CALL zsysv( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
1059 CALL chkxer( 'ZSYSV ', infot, nout, lerr, ok )
1060 infot = 8
1061 CALL zsysv( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
1062 CALL chkxer( 'ZSYSV ', infot, nout, lerr, ok )
1063 infot = 10
1064 CALL zsysv( 'U', 0, 0, a, 1, ip, b, 1, w, 0, info )
1065 CALL chkxer( 'ZSYSV ', infot, nout, lerr, ok )
1066 infot = 10
1067 CALL zsysv( 'U', 0, 0, a, 1, ip, b, 1, w, -2, info )
1068 CALL chkxer( 'ZSYSV ', infot, nout, lerr, ok )
1069*
1070* ZSYSVX
1071*
1072 srnamt = 'ZSYSVX'
1073 infot = 1
1074 CALL zsysvx( '/', 'U', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
1075 $ rcond, r1, r2, w, 1, rw, info )
1076 CALL chkxer( 'ZSYSVX', infot, nout, lerr, ok )
1077 infot = 2
1078 CALL zsysvx( 'N', '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
1079 $ rcond, r1, r2, w, 1, rw, info )
1080 CALL chkxer( 'ZSYSVX', infot, nout, lerr, ok )
1081 infot = 3
1082 CALL zsysvx( 'N', 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1,
1083 $ rcond, r1, r2, w, 1, rw, info )
1084 CALL chkxer( 'ZSYSVX', infot, nout, lerr, ok )
1085 infot = 4
1086 CALL zsysvx( 'N', 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1,
1087 $ rcond, r1, r2, w, 1, rw, info )
1088 CALL chkxer( 'ZSYSVX', infot, nout, lerr, ok )
1089 infot = 6
1090 CALL zsysvx( 'N', 'U', 2, 0, a, 1, af, 2, ip, b, 2, x, 2,
1091 $ rcond, r1, r2, w, 4, rw, info )
1092 CALL chkxer( 'ZSYSVX', infot, nout, lerr, ok )
1093 infot = 8
1094 CALL zsysvx( 'N', 'U', 2, 0, a, 2, af, 1, ip, b, 2, x, 2,
1095 $ rcond, r1, r2, w, 4, rw, info )
1096 CALL chkxer( 'ZSYSVX', infot, nout, lerr, ok )
1097 infot = 11
1098 CALL zsysvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 1, x, 2,
1099 $ rcond, r1, r2, w, 4, rw, info )
1100 CALL chkxer( 'ZSYSVX', infot, nout, lerr, ok )
1101 infot = 13
1102 CALL zsysvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 1,
1103 $ rcond, r1, r2, w, 4, rw, info )
1104 CALL chkxer( 'ZSYSVX', infot, nout, lerr, ok )
1105 infot = 18
1106 CALL zsysvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 2,
1107 $ rcond, r1, r2, w, 3, rw, info )
1108 CALL chkxer( 'ZSYSVX', infot, nout, lerr, ok )
1109*
1110* ZSYSVXX
1111*
1112 n_err_bnds = 3
1113 nparams = 1
1114 srnamt = 'ZSYSVXX'
1115 infot = 1
1116 eq = 'N'
1117 CALL zsysvxx( '/', 'U', 0, 0, a, 1, af, 1, ip, eq, r, b, 1, x,
1118 $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1119 $ err_bnds_c, nparams, params, w, rw, info )
1120 CALL chkxer( 'ZSYSVXX', infot, nout, lerr, ok )
1121 infot = 2
1122 CALL zsysvxx( 'N', '/', 0, 0, a, 1, af, 1, ip, eq, r, b, 1, x,
1123 $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1124 $ err_bnds_c, nparams, params, w, rw, info )
1125 CALL chkxer( 'ZSYSVXX', infot, nout, lerr, ok )
1126 infot = 3
1127 CALL zsysvxx( 'N', 'U', -1, 0, a, 1, af, 1, ip, eq, r, b, 1, x,
1128 $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1129 $ err_bnds_c, nparams, params, w, rw, info )
1130 CALL chkxer( 'ZSYSVXX', infot, nout, lerr, ok )
1131 infot = 4
1132 eq = '/'
1133 CALL zsysvxx( 'N', 'U', 0, -1, a, 1, af, 1, ip, eq, r, b, 1, x,
1134 $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1135 $ err_bnds_c, nparams, params, w, rw, info )
1136 CALL chkxer( 'ZSYSVXX', infot, nout, lerr, ok )
1137 eq = 'Y'
1138 infot = 6
1139 CALL zsysvxx( 'N', 'U', 2, 0, a, 1, af, 2, ip, eq, r, b, 2, x,
1140 $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1141 $ err_bnds_c, nparams, params, w, rw, info )
1142 CALL chkxer( 'ZSYSVXX', infot, nout, lerr, ok )
1143 infot = 8
1144 CALL zsysvxx( 'N', 'U', 2, 0, a, 2, af, 1, ip, eq, r, b, 2, x,
1145 $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1146 $ err_bnds_c, nparams, params, w, rw, info )
1147 CALL chkxer( 'ZSYSVXX', infot, nout, lerr, ok )
1148 infot = 10
1149 CALL zsysvxx( 'F', 'U', 2, 0, a, 2, af, 2, ip, 'A', r, b, 2, x,
1150 $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1151 $ err_bnds_c, nparams, params, w, rw, info )
1152 CALL chkxer( 'ZSYSVXX', infot, nout, lerr, ok )
1153 infot = 11
1154 eq='Y'
1155 CALL zsysvxx( 'F', 'U', 2, 0, a, 2, af, 2, ip, eq, r, b, 2, x,
1156 $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1157 $ err_bnds_c, nparams, params, w, rw, info )
1158 CALL chkxer( 'ZSYSVXX', infot, nout, lerr, ok )
1159 infot = 11
1160 eq='Y'
1161 r(1) = -one
1162 CALL zsysvxx( 'F', 'U', 2, 0, a, 2, af, 2, ip, eq, r, b, 2, x,
1163 $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1164 $ err_bnds_c, nparams, params, w, rw, info )
1165 CALL chkxer( 'ZSYSVXX', infot, nout, lerr, ok )
1166 infot = 13
1167 eq = 'N'
1168 CALL zsysvxx( 'N', 'U', 2, 0, a, 2, af, 2, ip, eq, r, b, 1, x,
1169 $ 2, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1170 $ err_bnds_c, nparams, params, w, rw, info )
1171 CALL chkxer( 'ZSYSVXX', infot, nout, lerr, ok )
1172 infot = 15
1173 CALL zsysvxx( 'N', 'U', 2, 0, a, 2, af, 2, ip, eq, r, b, 2, x,
1174 $ 1, rcond, rpvgrw, berr, n_err_bnds, err_bnds_n,
1175 $ err_bnds_c, nparams, params, w, rw, info )
1176 CALL chkxer( 'ZSYSVXX', infot, nout, lerr, ok )
1177*
1178 ELSE IF( lsamen( 2, c2, 'SR' ) ) THEN
1179*
1180* ZSYSV_ROOK
1181*
1182 srnamt = 'ZSYSV_ROOK'
1183 infot = 1
1184 CALL zsysv_rook( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
1185 CALL chkxer( 'ZSYSV_ROOK', infot, nout, lerr, ok )
1186 infot = 2
1187 CALL zsysv_rook( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
1188 CALL chkxer( 'ZSYSV_ROOK', infot, nout, lerr, ok )
1189 infot = 3
1190 CALL zsysv_rook( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
1191 CALL chkxer( 'ZSYSV_ROOK', infot, nout, lerr, ok )
1192 infot = 8
1193 CALL zsysv_rook( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
1194 CALL chkxer( 'ZSYSV_ROOK', infot, nout, lerr, ok )
1195 infot = 10
1196 CALL zsysv_rook( 'U', 0, 0, a, 1, ip, b, 1, w, 0, info )
1197 CALL chkxer( 'ZSYSV_ROOK', infot, nout, lerr, ok )
1198 infot = 10
1199 CALL zsysv_rook( 'U', 0, 0, a, 1, ip, b, 1, w, -2, info )
1200*
1201 ELSE IF( lsamen( 2, c2, 'SK' ) ) THEN
1202*
1203* ZSYSV_RK
1204*
1205* Test error exits of the driver that uses factorization
1206* of a symmetric indefinite matrix with rook
1207* (bounded Bunch-Kaufman) pivoting with the new storage
1208* format for factors L ( or U) and D.
1209*
1210* L (or U) is stored in A, diagonal of D is stored on the
1211* diagonal of A, subdiagonal of D is stored in a separate array E.
1212*
1213 srnamt = 'ZSYSV_RK'
1214 infot = 1
1215 CALL zsysv_rk( '/', 0, 0, a, 1, e, ip, b, 1, w, 1, info )
1216 CALL chkxer( 'ZSYSV_RK', infot, nout, lerr, ok )
1217 infot = 2
1218 CALL zsysv_rk( 'U', -1, 0, a, 1, e, ip, b, 1, w, 1, info )
1219 CALL chkxer( 'ZSYSV_RK', infot, nout, lerr, ok )
1220 infot = 3
1221 CALL zsysv_rk( 'U', 0, -1, a, 1, e, ip, b, 1, w, 1, info )
1222 CALL chkxer( 'ZSYSV_RK', infot, nout, lerr, ok )
1223 infot = 5
1224 CALL zsysv_rk( 'U', 2, 0, a, 1, e, ip, b, 2, w, 1, info )
1225 CALL chkxer( 'ZSYSV_RK', infot, nout, lerr, ok )
1226 infot = 9
1227 CALL zsysv_rk( 'U', 2, 0, a, 2, e, ip, b, 1, w, 1, info )
1228 CALL chkxer( 'ZSYSV_RK', infot, nout, lerr, ok )
1229 infot = 11
1230 CALL zsysv_rk( 'U', 0, 0, a, 1, e, ip, b, 1, w, 0, info )
1231 CALL chkxer( 'ZSYSV_RK', infot, nout, lerr, ok )
1232 infot = 11
1233 CALL zsysv_rk( 'U', 0, 0, a, 1, e, ip, b, 1, w, -2, info )
1234 CALL chkxer( 'ZSYSV_RK', infot, nout, lerr, ok )
1235*
1236 ELSE IF( lsamen( 2, c2, 'SP' ) ) THEN
1237*
1238* ZSPSV
1239*
1240 srnamt = 'ZSPSV '
1241 infot = 1
1242 CALL zspsv( '/', 0, 0, a, ip, b, 1, info )
1243 CALL chkxer( 'ZSPSV ', infot, nout, lerr, ok )
1244 infot = 2
1245 CALL zspsv( 'U', -1, 0, a, ip, b, 1, info )
1246 CALL chkxer( 'ZSPSV ', infot, nout, lerr, ok )
1247 infot = 3
1248 CALL zspsv( 'U', 0, -1, a, ip, b, 1, info )
1249 CALL chkxer( 'ZSPSV ', infot, nout, lerr, ok )
1250 infot = 7
1251 CALL zspsv( 'U', 2, 0, a, ip, b, 1, info )
1252 CALL chkxer( 'ZSPSV ', infot, nout, lerr, ok )
1253*
1254* ZSPSVX
1255*
1256 srnamt = 'ZSPSVX'
1257 infot = 1
1258 CALL zspsvx( '/', 'U', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
1259 $ r2, w, rw, info )
1260 CALL chkxer( 'ZSPSVX', infot, nout, lerr, ok )
1261 infot = 2
1262 CALL zspsvx( 'N', '/', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
1263 $ r2, w, rw, info )
1264 CALL chkxer( 'ZSPSVX', infot, nout, lerr, ok )
1265 infot = 3
1266 CALL zspsvx( 'N', 'U', -1, 0, a, af, ip, b, 1, x, 1, rcond, r1,
1267 $ r2, w, rw, info )
1268 CALL chkxer( 'ZSPSVX', infot, nout, lerr, ok )
1269 infot = 4
1270 CALL zspsvx( 'N', 'U', 0, -1, a, af, ip, b, 1, x, 1, rcond, r1,
1271 $ r2, w, rw, info )
1272 CALL chkxer( 'ZSPSVX', infot, nout, lerr, ok )
1273 infot = 9
1274 CALL zspsvx( 'N', 'U', 2, 0, a, af, ip, b, 1, x, 2, rcond, r1,
1275 $ r2, w, rw, info )
1276 CALL chkxer( 'ZSPSVX', infot, nout, lerr, ok )
1277 infot = 11
1278 CALL zspsvx( 'N', 'U', 2, 0, a, af, ip, b, 2, x, 1, rcond, r1,
1279 $ r2, w, rw, info )
1280 CALL chkxer( 'ZSPSVX', infot, nout, lerr, ok )
1281 END IF
1282*
1283* Print a summary line.
1284*
1285 IF( ok ) THEN
1286 WRITE( nout, fmt = 9999 )path
1287 ELSE
1288 WRITE( nout, fmt = 9998 )path
1289 END IF
1290*
1291 9999 FORMAT( 1x, a3, ' drivers passed the tests of the error exits' )
1292 9998 FORMAT( ' *** ', a3, ' drivers failed the tests of the error ',
1293 $ 'exits ***' )
1294*
1295 RETURN
1296*
1297* End of ZERRVXX
1298*
1299 END
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
subroutine zgbsv(n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
ZGBSV computes the solution to system of linear equations A * X = B for GB matrices (simple driver)
Definition zgbsv.f:162
subroutine zgbsvx(fact, trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, equed, r, c, b, ldb, x, ldx, rcond, ferr, berr, work, rwork, info)
ZGBSVX computes the solution to system of linear equations A * X = B for GB matrices
Definition zgbsvx.f:370
subroutine zgbsvxx(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)
ZGBSVXX computes the solution to system of linear equations A * X = B for GB matrices
Definition zgbsvxx.f:560
subroutine zgesv(n, nrhs, a, lda, ipiv, b, ldb, info)
Download ZGESV + dependencies <a href="http://www.netlib.org/cgi-bin/netlibfiles....
Definition zgesv.f:124
subroutine zgesvx(fact, trans, n, nrhs, a, lda, af, ldaf, ipiv, equed, r, c, b, ldb, x, ldx, rcond, ferr, berr, work, rwork, info)
ZGESVX computes the solution to system of linear equations A * X = B for GE matrices
Definition zgesvx.f:350
subroutine zgesvxx(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)
ZGESVXX computes the solution to system of linear equations A * X = B for GE matrices
Definition zgesvxx.f:540
subroutine zgtsv(n, nrhs, dl, d, du, b, ldb, info)
ZGTSV computes the solution to system of linear equations A * X = B for GT matrices
Definition zgtsv.f:124
subroutine zgtsvx(fact, trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, rwork, info)
ZGTSVX computes the solution to system of linear equations A * X = B for GT matrices
Definition zgtsvx.f:294
subroutine zhesv_rk(uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work, lwork, info)
ZHESV_RK computes the solution to system of linear equations A * X = B for SY matrices
Definition zhesv_rk.f:228
subroutine zsysv_rk(uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work, lwork, info)
ZSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices
Definition zsysv_rk.f:228
subroutine zhesv_rook(uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork, info)
ZHESV_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using the ...
Definition zhesv_rook.f:205
subroutine zsysv_rook(uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork, info)
ZSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices
Definition zsysv_rook.f:204
subroutine zhesv(uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork, info)
ZHESV computes the solution to system of linear equations A * X = B for HE matrices
Definition zhesv.f:171
subroutine zsysv(uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork, info)
ZSYSV computes the solution to system of linear equations A * X = B for SY matrices
Definition zsysv.f:171
subroutine zhesvx(fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, lwork, rwork, info)
ZHESVX computes the solution to system of linear equations A * X = B for HE matrices
Definition zhesvx.f:285
subroutine zsysvx(fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, lwork, rwork, info)
ZSYSVX computes the solution to system of linear equations A * X = B for SY matrices
Definition zsysvx.f:285
subroutine zsysvxx(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)
ZSYSVXX computes the solution to system of linear equations A * X = B for SY matrices
Definition zsysvxx.f:506
subroutine zhesvxx(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)
ZHESVXX computes the solution to system of linear equations A * X = B for HE matrices
Definition zhesvxx.f:506
subroutine zspsv(uplo, n, nrhs, ap, ipiv, b, ldb, info)
ZSPSV computes the solution to system of linear equations A * X = B for OTHER matrices
Definition zspsv.f:162
subroutine zhpsv(uplo, n, nrhs, ap, ipiv, b, ldb, info)
ZHPSV computes the solution to system of linear equations A * X = B for OTHER matrices
Definition zhpsv.f:162
subroutine zspsvx(fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, rwork, info)
ZSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices
Definition zspsvx.f:277
subroutine zhpsvx(fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, rwork, info)
ZHPSVX computes the solution to system of linear equations A * X = B for OTHER matrices
Definition zhpsvx.f:277
subroutine zpbsv(uplo, n, kd, nrhs, ab, ldab, b, ldb, info)
ZPBSV computes the solution to system of linear equations A * X = B for OTHER matrices
Definition zpbsv.f:164
subroutine zpbsvx(fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, rwork, info)
ZPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices
Definition zpbsvx.f:342
subroutine zposv(uplo, n, nrhs, a, lda, b, ldb, info)
ZPOSV computes the solution to system of linear equations A * X = B for PO matrices
Definition zposv.f:130
subroutine zposvx(fact, uplo, n, nrhs, a, lda, af, ldaf, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, rwork, info)
ZPOSVX computes the solution to system of linear equations A * X = B for PO matrices
Definition zposvx.f:306
subroutine zposvxx(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)
ZPOSVXX computes the solution to system of linear equations A * X = B for PO matrices
Definition zposvxx.f:493
subroutine zppsv(uplo, n, nrhs, ap, b, ldb, info)
ZPPSV computes the solution to system of linear equations A * X = B for OTHER matrices
Definition zppsv.f:144
subroutine zppsvx(fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, rwork, info)
ZPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices
Definition zppsvx.f:311
subroutine zptsv(n, nrhs, d, e, b, ldb, info)
ZPTSV computes the solution to system of linear equations A * X = B for PT matrices
Definition zptsv.f:115
subroutine zptsvx(fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx, rcond, ferr, berr, work, rwork, info)
ZPTSVX computes the solution to system of linear equations A * X = B for PT matrices
Definition zptsvx.f:234
subroutine zerrvx(path, nunit)
ZERRVX
Definition zerrvx.f:55