LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cerrvx.f
Go to the documentation of this file.
1*> \brief \b CERRVX
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*> \ingroup complex_lin
52*
53* =====================================================================
54 SUBROUTINE cerrvx( 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* ..
71* .. Local Scalars ..
72 CHARACTER EQ
73 CHARACTER*2 C2
74 INTEGER I, INFO, J
75 REAL RCOND
76* ..
77* .. Local Arrays ..
78 INTEGER IP( NMAX )
79 REAL C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
80 $ RF( NMAX ), RW( NMAX )
81 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
82 $ E( NMAX ), W( 2*NMAX ), X( NMAX )
83* ..
84* .. External Functions ..
85 LOGICAL LSAMEN
86 EXTERNAL lsamen
87* ..
88* .. External Subroutines ..
89 EXTERNAL cgbsv, cgbsvx, cgesv, cgesvx, cgtsv, cgtsvx,
95* ..
96* .. Scalars in Common ..
97 LOGICAL LERR, OK
98 CHARACTER*32 SRNAMT
99 INTEGER INFOT, NOUT
100* ..
101* .. Common blocks ..
102 COMMON / infoc / infot, nout, ok, lerr
103 COMMON / srnamc / srnamt
104* ..
105* .. Intrinsic Functions ..
106 INTRINSIC cmplx, real
107* ..
108* .. Executable Statements ..
109*
110 nout = nunit
111 WRITE( nout, fmt = * )
112 c2 = path( 2: 3 )
113*
114* Set the variables to innocuous values.
115*
116 DO 20 j = 1, nmax
117 DO 10 i = 1, nmax
118 a( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
119 af( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
120 10 CONTINUE
121 b( j ) = 0.e+0
122 e( j ) = 0.e+0
123 r1( j ) = 0.e+0
124 r2( j ) = 0.e+0
125 w( j ) = 0.e+0
126 x( j ) = 0.e+0
127 c( j ) = 0.e+0
128 r( j ) = 0.e+0
129 ip( j ) = j
130 20 CONTINUE
131 eq = ' '
132 ok = .true.
133*
134 IF( lsamen( 2, c2, 'GE' ) ) THEN
135*
136* CGESV
137*
138 srnamt = 'CGESV '
139 infot = 1
140 CALL cgesv( -1, 0, a, 1, ip, b, 1, info )
141 CALL chkxer( 'CGESV ', infot, nout, lerr, ok )
142 infot = 2
143 CALL cgesv( 0, -1, a, 1, ip, b, 1, info )
144 CALL chkxer( 'CGESV ', infot, nout, lerr, ok )
145 infot = 4
146 CALL cgesv( 2, 1, a, 1, ip, b, 2, info )
147 CALL chkxer( 'CGESV ', infot, nout, lerr, ok )
148 infot = 7
149 CALL cgesv( 2, 1, a, 2, ip, b, 1, info )
150 CALL chkxer( 'CGESV ', infot, nout, lerr, ok )
151*
152* CGESVX
153*
154 srnamt = 'CGESVX'
155 infot = 1
156 CALL cgesvx( '/', 'N', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
157 $ x, 1, rcond, r1, r2, w, rw, info )
158 CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
159 infot = 2
160 CALL cgesvx( 'N', '/', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
161 $ x, 1, rcond, r1, r2, w, rw, info )
162 CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
163 infot = 3
164 CALL cgesvx( 'N', 'N', -1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
165 $ x, 1, rcond, r1, r2, w, rw, info )
166 CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
167 infot = 4
168 CALL cgesvx( 'N', 'N', 0, -1, a, 1, af, 1, ip, eq, r, c, b, 1,
169 $ x, 1, rcond, r1, r2, w, rw, info )
170 CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
171 infot = 6
172 CALL cgesvx( 'N', 'N', 2, 1, a, 1, af, 2, ip, eq, r, c, b, 2,
173 $ x, 2, rcond, r1, r2, w, rw, info )
174 CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
175 infot = 8
176 CALL cgesvx( 'N', 'N', 2, 1, a, 2, af, 1, ip, eq, r, c, b, 2,
177 $ x, 2, rcond, r1, r2, w, rw, info )
178 CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
179 infot = 10
180 eq = '/'
181 CALL cgesvx( 'F', 'N', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
182 $ x, 1, rcond, r1, r2, w, rw, info )
183 CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
184 infot = 11
185 eq = 'R'
186 CALL cgesvx( 'F', 'N', 1, 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 = 12
190 eq = 'C'
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 = 14
195 CALL cgesvx( 'N', 'N', 2, 1, a, 2, af, 2, ip, eq, r, c, b, 1,
196 $ x, 2, rcond, r1, r2, w, rw, info )
197 CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
198 infot = 16
199 CALL cgesvx( 'N', 'N', 2, 1, a, 2, af, 2, ip, eq, r, c, b, 2,
200 $ x, 1, rcond, r1, r2, w, rw, info )
201 CALL chkxer( 'CGESVX', infot, nout, lerr, ok )
202*
203 ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
204*
205* CGBSV
206*
207 srnamt = 'CGBSV '
208 infot = 1
209 CALL cgbsv( -1, 0, 0, 0, a, 1, ip, b, 1, info )
210 CALL chkxer( 'CGBSV ', infot, nout, lerr, ok )
211 infot = 2
212 CALL cgbsv( 1, -1, 0, 0, a, 1, ip, b, 1, info )
213 CALL chkxer( 'CGBSV ', infot, nout, lerr, ok )
214 infot = 3
215 CALL cgbsv( 1, 0, -1, 0, a, 1, ip, b, 1, info )
216 CALL chkxer( 'CGBSV ', infot, nout, lerr, ok )
217 infot = 4
218 CALL cgbsv( 0, 0, 0, -1, a, 1, ip, b, 1, info )
219 CALL chkxer( 'CGBSV ', infot, nout, lerr, ok )
220 infot = 6
221 CALL cgbsv( 1, 1, 1, 0, a, 3, ip, b, 1, info )
222 CALL chkxer( 'CGBSV ', infot, nout, lerr, ok )
223 infot = 9
224 CALL cgbsv( 2, 0, 0, 0, a, 1, ip, b, 1, info )
225 CALL chkxer( 'CGBSV ', infot, nout, lerr, ok )
226*
227* CGBSVX
228*
229 srnamt = 'CGBSVX'
230 infot = 1
231 CALL cgbsvx( '/', 'N', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
232 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
233 CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
234 infot = 2
235 CALL cgbsvx( 'N', '/', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
236 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
237 CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
238 infot = 3
239 CALL cgbsvx( 'N', 'N', -1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
240 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
241 CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
242 infot = 4
243 CALL cgbsvx( 'N', 'N', 1, -1, 0, 0, a, 1, af, 1, ip, eq, r, c,
244 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
245 CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
246 infot = 5
247 CALL cgbsvx( 'N', 'N', 1, 0, -1, 0, a, 1, af, 1, ip, eq, r, c,
248 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
249 CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
250 infot = 6
251 CALL cgbsvx( 'N', 'N', 0, 0, 0, -1, a, 1, af, 1, ip, eq, r, c,
252 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
253 CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
254 infot = 8
255 CALL cgbsvx( 'N', 'N', 1, 1, 1, 0, a, 2, af, 4, ip, eq, r, c,
256 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
257 CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
258 infot = 10
259 CALL cgbsvx( 'N', 'N', 1, 1, 1, 0, a, 3, af, 3, ip, eq, r, c,
260 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
261 CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
262 infot = 12
263 eq = '/'
264 CALL cgbsvx( 'F', 'N', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
265 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
266 CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
267 infot = 13
268 eq = 'R'
269 CALL cgbsvx( 'F', 'N', 1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
270 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
271 CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
272 infot = 14
273 eq = 'C'
274 CALL cgbsvx( 'F', 'N', 1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
275 $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
276 CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
277 infot = 16
278 CALL cgbsvx( 'N', 'N', 2, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
279 $ b, 1, x, 2, rcond, r1, r2, w, rw, info )
280 CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
281 infot = 18
282 CALL cgbsvx( 'N', 'N', 2, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
283 $ b, 2, x, 1, rcond, r1, r2, w, rw, info )
284 CALL chkxer( 'CGBSVX', infot, nout, lerr, ok )
285*
286 ELSE IF( lsamen( 2, c2, 'GT' ) ) THEN
287*
288* CGTSV
289*
290 srnamt = 'CGTSV '
291 infot = 1
292 CALL cgtsv( -1, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1,
293 $ info )
294 CALL chkxer( 'CGTSV ', infot, nout, lerr, ok )
295 infot = 2
296 CALL cgtsv( 0, -1, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1,
297 $ info )
298 CALL chkxer( 'CGTSV ', infot, nout, lerr, ok )
299 infot = 7
300 CALL cgtsv( 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1, info )
301 CALL chkxer( 'CGTSV ', infot, nout, lerr, ok )
302*
303* CGTSVX
304*
305 srnamt = 'CGTSVX'
306 infot = 1
307 CALL cgtsvx( '/', 'N', 0, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
308 $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
309 $ ip, b, 1, x, 1, rcond, r1, r2, w, rw, info )
310 CALL chkxer( 'CGTSVX', infot, nout, lerr, ok )
311 infot = 2
312 CALL cgtsvx( 'N', '/', 0, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
313 $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
314 $ ip, b, 1, x, 1, rcond, r1, r2, w, rw, info )
315 CALL chkxer( 'CGTSVX', infot, nout, lerr, ok )
316 infot = 3
317 CALL cgtsvx( 'N', 'N', -1, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
318 $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
319 $ ip, b, 1, x, 1, rcond, r1, r2, w, rw, info )
320 CALL chkxer( 'CGTSVX', infot, nout, lerr, ok )
321 infot = 4
322 CALL cgtsvx( 'N', 'N', 0, -1, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
323 $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
324 $ ip, b, 1, x, 1, rcond, r1, r2, w, rw, info )
325 CALL chkxer( 'CGTSVX', infot, nout, lerr, ok )
326 infot = 14
327 CALL cgtsvx( 'N', 'N', 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
328 $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
329 $ ip, b, 1, x, 2, rcond, r1, r2, w, rw, info )
330 CALL chkxer( 'CGTSVX', infot, nout, lerr, ok )
331 infot = 16
332 CALL cgtsvx( 'N', 'N', 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
333 $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
334 $ ip, b, 2, x, 1, rcond, r1, r2, w, rw, info )
335 CALL chkxer( 'CGTSVX', infot, nout, lerr, ok )
336*
337 ELSE IF( lsamen( 2, c2, 'PO' ) ) THEN
338*
339* CPOSV
340*
341 srnamt = 'CPOSV '
342 infot = 1
343 CALL cposv( '/', 0, 0, a, 1, b, 1, info )
344 CALL chkxer( 'CPOSV ', infot, nout, lerr, ok )
345 infot = 2
346 CALL cposv( 'U', -1, 0, a, 1, b, 1, info )
347 CALL chkxer( 'CPOSV ', infot, nout, lerr, ok )
348 infot = 3
349 CALL cposv( 'U', 0, -1, a, 1, b, 1, info )
350 CALL chkxer( 'CPOSV ', infot, nout, lerr, ok )
351 infot = 5
352 CALL cposv( 'U', 2, 0, a, 1, b, 2, info )
353 CALL chkxer( 'CPOSV ', infot, nout, lerr, ok )
354 infot = 7
355 CALL cposv( 'U', 2, 0, a, 2, b, 1, info )
356 CALL chkxer( 'CPOSV ', infot, nout, lerr, ok )
357*
358* CPOSVX
359*
360 srnamt = 'CPOSVX'
361 infot = 1
362 CALL cposvx( '/', 'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
363 $ rcond, r1, r2, w, rw, info )
364 CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
365 infot = 2
366 CALL cposvx( 'N', '/', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
367 $ rcond, r1, r2, w, rw, info )
368 CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
369 infot = 3
370 CALL cposvx( 'N', 'U', -1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
371 $ rcond, r1, r2, w, rw, info )
372 CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
373 infot = 4
374 CALL cposvx( 'N', 'U', 0, -1, a, 1, af, 1, eq, c, b, 1, x, 1,
375 $ rcond, r1, r2, w, rw, info )
376 CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
377 infot = 6
378 CALL cposvx( 'N', 'U', 2, 0, a, 1, af, 2, eq, c, b, 2, x, 2,
379 $ rcond, r1, r2, w, rw, info )
380 CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
381 infot = 8
382 CALL cposvx( 'N', 'U', 2, 0, a, 2, af, 1, eq, c, b, 2, x, 2,
383 $ rcond, r1, r2, w, rw, info )
384 CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
385 infot = 9
386 eq = '/'
387 CALL cposvx( 'F', 'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
388 $ rcond, r1, r2, w, rw, info )
389 CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
390 infot = 10
391 eq = 'Y'
392 CALL cposvx( 'F', 'U', 1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
393 $ rcond, r1, r2, w, rw, info )
394 CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
395 infot = 12
396 CALL cposvx( 'N', 'U', 2, 0, a, 2, af, 2, eq, c, b, 1, x, 2,
397 $ rcond, r1, r2, w, rw, info )
398 CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
399 infot = 14
400 CALL cposvx( 'N', 'U', 2, 0, a, 2, af, 2, eq, c, b, 2, x, 1,
401 $ rcond, r1, r2, w, rw, info )
402 CALL chkxer( 'CPOSVX', infot, nout, lerr, ok )
403*
404 ELSE IF( lsamen( 2, c2, 'PP' ) ) THEN
405*
406* CPPSV
407*
408 srnamt = 'CPPSV '
409 infot = 1
410 CALL cppsv( '/', 0, 0, a, b, 1, info )
411 CALL chkxer( 'CPPSV ', infot, nout, lerr, ok )
412 infot = 2
413 CALL cppsv( 'U', -1, 0, a, b, 1, info )
414 CALL chkxer( 'CPPSV ', infot, nout, lerr, ok )
415 infot = 3
416 CALL cppsv( 'U', 0, -1, a, b, 1, info )
417 CALL chkxer( 'CPPSV ', infot, nout, lerr, ok )
418 infot = 6
419 CALL cppsv( 'U', 2, 0, a, b, 1, info )
420 CALL chkxer( 'CPPSV ', infot, nout, lerr, ok )
421*
422* CPPSVX
423*
424 srnamt = 'CPPSVX'
425 infot = 1
426 CALL cppsvx( '/', 'U', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
427 $ r1, r2, w, rw, info )
428 CALL chkxer( 'CPPSVX', infot, nout, lerr, ok )
429 infot = 2
430 CALL cppsvx( 'N', '/', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
431 $ r1, r2, w, rw, info )
432 CALL chkxer( 'CPPSVX', infot, nout, lerr, ok )
433 infot = 3
434 CALL cppsvx( 'N', 'U', -1, 0, a, af, eq, c, b, 1, x, 1, rcond,
435 $ r1, r2, w, rw, info )
436 CALL chkxer( 'CPPSVX', infot, nout, lerr, ok )
437 infot = 4
438 CALL cppsvx( 'N', 'U', 0, -1, a, af, eq, c, b, 1, x, 1, rcond,
439 $ r1, r2, w, rw, info )
440 CALL chkxer( 'CPPSVX', infot, nout, lerr, ok )
441 infot = 7
442 eq = '/'
443 CALL cppsvx( 'F', 'U', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
444 $ r1, r2, w, rw, info )
445 CALL chkxer( 'CPPSVX', infot, nout, lerr, ok )
446 infot = 8
447 eq = 'Y'
448 CALL cppsvx( 'F', 'U', 1, 0, a, af, eq, c, b, 1, x, 1, rcond,
449 $ r1, r2, w, rw, info )
450 CALL chkxer( 'CPPSVX', infot, nout, lerr, ok )
451 infot = 10
452 CALL cppsvx( 'N', 'U', 2, 0, a, af, eq, c, b, 1, x, 2, rcond,
453 $ r1, r2, w, rw, info )
454 CALL chkxer( 'CPPSVX', infot, nout, lerr, ok )
455 infot = 12
456 CALL cppsvx( 'N', 'U', 2, 0, a, af, eq, c, b, 2, x, 1, rcond,
457 $ r1, r2, w, rw, info )
458 CALL chkxer( 'CPPSVX', infot, nout, lerr, ok )
459*
460 ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
461*
462* CPBSV
463*
464 srnamt = 'CPBSV '
465 infot = 1
466 CALL cpbsv( '/', 0, 0, 0, a, 1, b, 1, info )
467 CALL chkxer( 'CPBSV ', infot, nout, lerr, ok )
468 infot = 2
469 CALL cpbsv( 'U', -1, 0, 0, a, 1, b, 1, info )
470 CALL chkxer( 'CPBSV ', infot, nout, lerr, ok )
471 infot = 3
472 CALL cpbsv( 'U', 1, -1, 0, a, 1, b, 1, info )
473 CALL chkxer( 'CPBSV ', infot, nout, lerr, ok )
474 infot = 4
475 CALL cpbsv( 'U', 0, 0, -1, a, 1, b, 1, info )
476 CALL chkxer( 'CPBSV ', infot, nout, lerr, ok )
477 infot = 6
478 CALL cpbsv( 'U', 1, 1, 0, a, 1, b, 2, info )
479 CALL chkxer( 'CPBSV ', infot, nout, lerr, ok )
480 infot = 8
481 CALL cpbsv( 'U', 2, 0, 0, a, 1, b, 1, info )
482 CALL chkxer( 'CPBSV ', infot, nout, lerr, ok )
483*
484* CPBSVX
485*
486 srnamt = 'CPBSVX'
487 infot = 1
488 CALL cpbsvx( '/', 'U', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
489 $ rcond, r1, r2, w, rw, info )
490 CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
491 infot = 2
492 CALL cpbsvx( 'N', '/', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
493 $ rcond, r1, r2, w, rw, info )
494 CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
495 infot = 3
496 CALL cpbsvx( 'N', 'U', -1, 0, 0, a, 1, af, 1, eq, c, b, 1, x,
497 $ 1, rcond, r1, r2, w, rw, info )
498 CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
499 infot = 4
500 CALL cpbsvx( 'N', 'U', 1, -1, 0, a, 1, af, 1, eq, c, b, 1, x,
501 $ 1, rcond, r1, r2, w, rw, info )
502 CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
503 infot = 5
504 CALL cpbsvx( 'N', 'U', 0, 0, -1, a, 1, af, 1, eq, c, b, 1, x,
505 $ 1, rcond, r1, r2, w, rw, info )
506 CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
507 infot = 7
508 CALL cpbsvx( 'N', 'U', 1, 1, 0, a, 1, af, 2, eq, c, b, 2, x, 2,
509 $ rcond, r1, r2, w, rw, info )
510 CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
511 infot = 9
512 CALL cpbsvx( 'N', 'U', 1, 1, 0, a, 2, af, 1, eq, c, b, 2, x, 2,
513 $ rcond, r1, r2, w, rw, info )
514 CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
515 infot = 10
516 eq = '/'
517 CALL cpbsvx( 'F', 'U', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
518 $ rcond, r1, r2, w, rw, info )
519 CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
520 infot = 11
521 eq = 'Y'
522 CALL cpbsvx( 'F', 'U', 1, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
523 $ rcond, r1, r2, w, rw, info )
524 CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
525 infot = 13
526 CALL cpbsvx( 'N', 'U', 2, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 2,
527 $ rcond, r1, r2, w, rw, info )
528 CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
529 infot = 15
530 CALL cpbsvx( 'N', 'U', 2, 0, 0, a, 1, af, 1, eq, c, b, 2, x, 1,
531 $ rcond, r1, r2, w, rw, info )
532 CALL chkxer( 'CPBSVX', infot, nout, lerr, ok )
533*
534 ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
535*
536* CPTSV
537*
538 srnamt = 'CPTSV '
539 infot = 1
540 CALL cptsv( -1, 0, r, a( 1, 1 ), b, 1, info )
541 CALL chkxer( 'CPTSV ', infot, nout, lerr, ok )
542 infot = 2
543 CALL cptsv( 0, -1, r, a( 1, 1 ), b, 1, info )
544 CALL chkxer( 'CPTSV ', infot, nout, lerr, ok )
545 infot = 6
546 CALL cptsv( 2, 0, r, a( 1, 1 ), b, 1, info )
547 CALL chkxer( 'CPTSV ', infot, nout, lerr, ok )
548*
549* CPTSVX
550*
551 srnamt = 'CPTSVX'
552 infot = 1
553 CALL cptsvx( '/', 0, 0, r, a( 1, 1 ), rf, af( 1, 1 ), b, 1, x,
554 $ 1, rcond, r1, r2, w, rw, info )
555 CALL chkxer( 'CPTSVX', infot, nout, lerr, ok )
556 infot = 2
557 CALL cptsvx( 'N', -1, 0, r, a( 1, 1 ), rf, af( 1, 1 ), b, 1, x,
558 $ 1, rcond, r1, r2, w, rw, info )
559 CALL chkxer( 'CPTSVX', infot, nout, lerr, ok )
560 infot = 3
561 CALL cptsvx( 'N', 0, -1, r, a( 1, 1 ), rf, af( 1, 1 ), b, 1, x,
562 $ 1, rcond, r1, r2, w, rw, info )
563 CALL chkxer( 'CPTSVX', infot, nout, lerr, ok )
564 infot = 9
565 CALL cptsvx( 'N', 2, 0, r, a( 1, 1 ), rf, af( 1, 1 ), b, 1, x,
566 $ 2, rcond, r1, r2, w, rw, info )
567 CALL chkxer( 'CPTSVX', infot, nout, lerr, ok )
568 infot = 11
569 CALL cptsvx( 'N', 2, 0, r, a( 1, 1 ), rf, af( 1, 1 ), b, 2, x,
570 $ 1, rcond, r1, r2, w, rw, info )
571 CALL chkxer( 'CPTSVX', infot, nout, lerr, ok )
572*
573 ELSE IF( lsamen( 2, c2, 'HE' ) ) THEN
574*
575* CHESV
576*
577 srnamt = 'CHESV '
578 infot = 1
579 CALL chesv( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
580 CALL chkxer( 'CHESV ', infot, nout, lerr, ok )
581 infot = 2
582 CALL chesv( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
583 CALL chkxer( 'CHESV ', infot, nout, lerr, ok )
584 infot = 3
585 CALL chesv( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
586 CALL chkxer( 'CHESV ', infot, nout, lerr, ok )
587 infot = 5
588 CALL chesv( 'U', 2, 0, a, 1, ip, b, 2, w, 1, info )
589 CALL chkxer( 'CHESV ', infot, nout, lerr, ok )
590 infot = 8
591 CALL chesv( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
592 CALL chkxer( 'CHESV ', infot, nout, lerr, ok )
593 infot = 10
594 CALL chesv( 'U', 0, 0, a, 1, ip, b, 1, w, 0, info )
595 CALL chkxer( 'CHESV ', infot, nout, lerr, ok )
596 infot = 10
597 CALL chesv( 'U', 0, 0, a, 1, ip, b, 1, w, -2, info )
598 CALL chkxer( 'CHESV ', infot, nout, lerr, ok )
599*
600* CHESVX
601*
602 srnamt = 'CHESVX'
603 infot = 1
604 CALL chesvx( '/', 'U', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
605 $ rcond, r1, r2, w, 1, rw, info )
606 CALL chkxer( 'CHESVX', infot, nout, lerr, ok )
607 infot = 2
608 CALL chesvx( 'N', '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
609 $ rcond, r1, r2, w, 1, rw, info )
610 CALL chkxer( 'CHESVX', infot, nout, lerr, ok )
611 infot = 3
612 CALL chesvx( 'N', 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1,
613 $ rcond, r1, r2, w, 1, rw, info )
614 CALL chkxer( 'CHESVX', infot, nout, lerr, ok )
615 infot = 4
616 CALL chesvx( 'N', 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1,
617 $ rcond, r1, r2, w, 1, rw, info )
618 CALL chkxer( 'CHESVX', infot, nout, lerr, ok )
619 infot = 6
620 CALL chesvx( 'N', 'U', 2, 0, a, 1, af, 2, ip, b, 2, x, 2,
621 $ rcond, r1, r2, w, 4, rw, info )
622 CALL chkxer( 'CHESVX', infot, nout, lerr, ok )
623 infot = 8
624 CALL chesvx( 'N', 'U', 2, 0, a, 2, af, 1, ip, b, 2, x, 2,
625 $ rcond, r1, r2, w, 4, rw, info )
626 CALL chkxer( 'CHESVX', infot, nout, lerr, ok )
627 infot = 11
628 CALL chesvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 1, x, 2,
629 $ rcond, r1, r2, w, 4, rw, info )
630 CALL chkxer( 'CHESVX', infot, nout, lerr, ok )
631 infot = 13
632 CALL chesvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 1,
633 $ rcond, r1, r2, w, 4, rw, info )
634 CALL chkxer( 'CHESVX', infot, nout, lerr, ok )
635 infot = 18
636 CALL chesvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 2,
637 $ rcond, r1, r2, w, 3, rw, info )
638 CALL chkxer( 'CHESVX', infot, nout, lerr, ok )
639*
640 ELSE IF( lsamen( 2, c2, 'HR' ) ) THEN
641*
642* CHESV_ROOK
643*
644 srnamt = 'CHESV_ROOK'
645 infot = 1
646 CALL chesv_rook( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
647 CALL chkxer( 'CHESV_ROOK', infot, nout, lerr, ok )
648 infot = 2
649 CALL chesv_rook( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
650 CALL chkxer( 'CHESV_ROOK', infot, nout, lerr, ok )
651 infot = 3
652 CALL chesv_rook( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
653 CALL chkxer( 'CHESV_ROOK', infot, nout, lerr, ok )
654 infot = 5
655 CALL chesv_rook( 'U', 2, 0, a, 1, ip, b, 2, w, 1, info )
656 CALL chkxer( 'CHESV_ROOK', infot, nout, lerr, ok )
657 infot = 8
658 CALL chesv_rook( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
659 CALL chkxer( 'CHESV_ROOK', infot, nout, lerr, ok )
660 infot = 10
661 CALL chesv_rook( 'U', 0, 0, a, 1, ip, b, 1, w, 0, info )
662 CALL chkxer( 'CHESV_ROOK', infot, nout, lerr, ok )
663 infot = 10
664 CALL chesv_rook( 'U', 0, 0, a, 1, ip, b, 1, w, -2, info )
665 CALL chkxer( 'CHESV_ROOK', infot, nout, lerr, ok )
666*
667 ELSE IF( lsamen( 2, c2, 'HK' ) ) THEN
668*
669* CHESV_RK
670*
671* Test error exits of the driver that uses factorization
672* of a symmetric indefinite matrix with rook
673* (bounded Bunch-Kaufman) pivoting with the new storage
674* format for factors L ( or U) and D.
675*
676* L (or U) is stored in A, diagonal of D is stored on the
677* diagonal of A, subdiagonal of D is stored in a separate array E.
678*
679 srnamt = 'CHESV_RK'
680 infot = 1
681 CALL chesv_rk( '/', 0, 0, a, 1, e, ip, b, 1, w, 1, info )
682 CALL chkxer( 'CHESV_RK', infot, nout, lerr, ok )
683 infot = 2
684 CALL chesv_rk( 'U', -1, 0, a, 1, e, ip, b, 1, w, 1, info )
685 CALL chkxer( 'CHESV_RK', infot, nout, lerr, ok )
686 infot = 3
687 CALL chesv_rk( 'U', 0, -1, a, 1, e, ip, b, 1, w, 1, info )
688 CALL chkxer( 'CHESV_RK', infot, nout, lerr, ok )
689 infot = 5
690 CALL chesv_rk( 'U', 2, 0, a, 1, e, ip, b, 2, w, 1, info )
691 CALL chkxer( 'CHESV_RK', infot, nout, lerr, ok )
692 infot = 9
693 CALL chesv_rk( 'U', 2, 0, a, 2, e, ip, b, 1, w, 1, info )
694 CALL chkxer( 'CHESV_RK', infot, nout, lerr, ok )
695 infot = 11
696 CALL chesv_rk( 'U', 0, 0, a, 1, e, ip, b, 1, w, 0, info )
697 CALL chkxer( 'CHESV_RK', infot, nout, lerr, ok )
698 infot = 11
699 CALL chesv_rk( 'U', 0, 0, a, 1, e, ip, b, 1, w, -2, info )
700 CALL chkxer( 'CHESV_RK', infot, nout, lerr, ok )
701*
702 ELSE IF( lsamen( 2, c2, 'HA' ) ) THEN
703*
704* CHESV_AASEN
705*
706 srnamt = 'CHESV_AA'
707 infot = 1
708 CALL chesv_aa( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
709 CALL chkxer( 'CHESV_AA', infot, nout, lerr, ok )
710 infot = 2
711 CALL chesv_aa( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
712 CALL chkxer( 'CHESV_AA', infot, nout, lerr, ok )
713 infot = 3
714 CALL chesv_aa( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
715 CALL chkxer( 'CHESV_AA', infot, nout, lerr, ok )
716 infot = 5
717 CALL chesv_aa( 'U', 2, 0, a, 1, ip, b, 2, w, 1, info )
718 CALL chkxer( 'CHESV_AA', infot, nout, lerr, ok )
719 infot = 8
720 CALL chesv_aa( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
721 CALL chkxer( 'CHESV_AA', infot, nout, lerr, ok )
722 infot = 10
723 CALL chesv_aa( 'U', 3, 1, a, 3, ip, b, 3, w, 6, info )
724 CALL chkxer( 'CHESV_AA', infot, nout, lerr, ok )
725*
726 ELSE IF( lsamen( 2, c2, 'H2' ) ) THEN
727*
728* CHESV_AASEN_2STAGE
729*
730 srnamt = 'CHESV_AA_2STAGE'
731 infot = 1
732 CALL chesv_aa_2stage( '/', 0, 0, a, 1, a, 1, ip, ip, b, 1,
733 $ w, 1, info )
734 CALL chkxer( 'CHESV_AA_2STAGE', infot, nout, lerr, ok )
735 infot = 2
736 CALL chesv_aa_2stage( 'U', -1, 0, a, 1, a, 1, ip, ip, b, 1,
737 $ w, 1, info )
738 CALL chkxer( 'CHESV_AA_2STAGE', infot, nout, lerr, ok )
739 infot = 3
740 CALL chesv_aa_2stage( 'U', 0, -1, a, 1, a, 1, ip, ip, b, 1,
741 $ w, 1, info )
742 CALL chkxer( 'CHESV_AA_2STAGE', infot, nout, lerr, ok )
743 infot = 5
744 CALL chesv_aa_2stage( 'U', 2, 1, a, 1, a, 1, ip, ip, b, 1,
745 $ w, 1, info )
746 CALL chkxer( 'CHESV_AA_2STAGE', infot, nout, lerr, ok )
747 infot = 7
748 CALL chesv_aa_2stage( 'U', 2, 1, a, 2, a, 1, ip, ip, b, 2,
749 $ w, 1, info )
750 CALL chkxer( 'CHESV_AA_2STAGE', infot, nout, lerr, ok )
751 infot = 11
752 CALL chesv_aa_2stage( 'U', 2, 1, a, 2, a, 8, ip, ip, b, 1,
753 $ w, 1, info )
754 CALL chkxer( 'CHESV_AA_2STAGE', infot, nout, lerr, ok )
755 infot = 13
756 CALL chesv_aa_2stage( 'U', 2, 1, a, 2, a, 8, ip, ip, b, 2,
757 $ w, 1, info )
758 CALL chkxer( 'CHESV_AA_2STAGE', infot, nout, lerr, ok )
759*
760 ELSE IF( lsamen( 2, c2, 'SA' ) ) THEN
761*
762* CSYSV_AASEN
763*
764 srnamt = 'CSYSV_AA'
765 infot = 1
766 CALL csysv_aa( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
767 CALL chkxer( 'CSYSV_AA', infot, nout, lerr, ok )
768 infot = 2
769 CALL csysv_aa( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
770 CALL chkxer( 'CSYSV_AA', infot, nout, lerr, ok )
771 infot = 3
772 CALL csysv_aa( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
773 CALL chkxer( 'CSYSV_AA', infot, nout, lerr, ok )
774 infot = 5
775 CALL csysv_aa( 'U', 2, 0, a, 1, ip, b, 2, w, 1, info )
776 CALL chkxer( 'CSYSV_AA', infot, nout, lerr, ok )
777 infot = 8
778 CALL csysv_aa( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
779 CALL chkxer( 'CSYSV_AA', infot, nout, lerr, ok )
780 infot = 10
781 CALL csysv_aa( 'U', 3, 1, a, 3, ip, b, 3, w, 6, info )
782 CALL chkxer( 'CSYSV_AA', infot, nout, lerr, ok )
783*
784 ELSE IF( lsamen( 2, c2, 'S2' ) ) THEN
785*
786* CSYSV_AASEN_2STAGE
787*
788 srnamt = 'CSYSV_AA_2STAGE'
789 infot = 1
790 CALL csysv_aa_2stage( '/', 0, 0, a, 1, a, 1, ip, ip, b, 1,
791 $ w, 1, info )
792 CALL chkxer( 'CSYSV_AA_2STAGE', infot, nout, lerr, ok )
793 infot = 2
794 CALL csysv_aa_2stage( 'U', -1, 0, a, 1, a, 1, ip, ip, b, 1,
795 $ w, 1, info )
796 CALL chkxer( 'CSYSV_AA_2STAGE', infot, nout, lerr, ok )
797 infot = 3
798 CALL csysv_aa_2stage( 'U', 0, -1, a, 1, a, 1, ip, ip, b, 1,
799 $ w, 1, info )
800 CALL chkxer( 'CSYSV_AA_2STAGE', infot, nout, lerr, ok )
801 infot = 5
802 CALL csysv_aa_2stage( 'U', 2, 1, a, 1, a, 1, ip, ip, b, 1,
803 $ w, 1, info )
804 CALL chkxer( 'CSYSV_AA_2STAGE', infot, nout, lerr, ok )
805 infot = 7
806 CALL csysv_aa_2stage( 'U', 2, 1, a, 2, a, 1, ip, ip, b, 2,
807 $ w, 1, info )
808 CALL chkxer( 'CSYSV_AA_2STAGE', infot, nout, lerr, ok )
809 infot = 11
810 CALL csysv_aa_2stage( 'U', 2, 1, a, 2, a, 8, ip, ip, b, 1,
811 $ w, 1, info )
812 CALL chkxer( 'CSYSV_AA_2STAGE', infot, nout, lerr, ok )
813 infot = 13
814 CALL csysv_aa_2stage( 'U', 2, 1, a, 2, a, 8, ip, ip, b, 2,
815 $ w, 1, info )
816 CALL chkxer( 'CSYSV_AA_2STAGE', infot, nout, lerr, ok )
817*
818 ELSE IF( lsamen( 2, c2, 'HP' ) ) THEN
819*
820* CHPSV
821*
822 srnamt = 'CHPSV '
823 infot = 1
824 CALL chpsv( '/', 0, 0, a, ip, b, 1, info )
825 CALL chkxer( 'CHPSV ', infot, nout, lerr, ok )
826 infot = 2
827 CALL chpsv( 'U', -1, 0, a, ip, b, 1, info )
828 CALL chkxer( 'CHPSV ', infot, nout, lerr, ok )
829 infot = 3
830 CALL chpsv( 'U', 0, -1, a, ip, b, 1, info )
831 CALL chkxer( 'CHPSV ', infot, nout, lerr, ok )
832 infot = 7
833 CALL chpsv( 'U', 2, 0, a, ip, b, 1, info )
834 CALL chkxer( 'CHPSV ', infot, nout, lerr, ok )
835*
836* CHPSVX
837*
838 srnamt = 'CHPSVX'
839 infot = 1
840 CALL chpsvx( '/', 'U', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
841 $ r2, w, rw, info )
842 CALL chkxer( 'CHPSVX', infot, nout, lerr, ok )
843 infot = 2
844 CALL chpsvx( 'N', '/', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
845 $ r2, w, rw, info )
846 CALL chkxer( 'CHPSVX', infot, nout, lerr, ok )
847 infot = 3
848 CALL chpsvx( 'N', 'U', -1, 0, a, af, ip, b, 1, x, 1, rcond, r1,
849 $ r2, w, rw, info )
850 CALL chkxer( 'CHPSVX', infot, nout, lerr, ok )
851 infot = 4
852 CALL chpsvx( 'N', 'U', 0, -1, a, af, ip, b, 1, x, 1, rcond, r1,
853 $ r2, w, rw, info )
854 CALL chkxer( 'CHPSVX', infot, nout, lerr, ok )
855 infot = 9
856 CALL chpsvx( 'N', 'U', 2, 0, a, af, ip, b, 1, x, 2, rcond, r1,
857 $ r2, w, rw, info )
858 CALL chkxer( 'CHPSVX', infot, nout, lerr, ok )
859 infot = 11
860 CALL chpsvx( 'N', 'U', 2, 0, a, af, ip, b, 2, x, 1, rcond, r1,
861 $ r2, w, rw, info )
862 CALL chkxer( 'CHPSVX', infot, nout, lerr, ok )
863*
864 ELSE IF( lsamen( 2, c2, 'SY' ) ) THEN
865*
866* CSYSV
867*
868 srnamt = 'CSYSV '
869 infot = 1
870 CALL csysv( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
871 CALL chkxer( 'CSYSV ', infot, nout, lerr, ok )
872 infot = 2
873 CALL csysv( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
874 CALL chkxer( 'CSYSV ', infot, nout, lerr, ok )
875 infot = 3
876 CALL csysv( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
877 CALL chkxer( 'CSYSV ', infot, nout, lerr, ok )
878 infot = 5
879 CALL csysv( 'U', 2, 0, a, 1, ip, b, 2, w, 1, info )
880 CALL chkxer( 'CSYSV ', infot, nout, lerr, ok )
881 infot = 8
882 CALL csysv( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
883 CALL chkxer( 'CSYSV ', infot, nout, lerr, ok )
884 infot = 10
885 CALL csysv( 'U', 0, 0, a, 1, ip, b, 1, w, 0, info )
886 CALL chkxer( 'CSYSV ', infot, nout, lerr, ok )
887 infot = 10
888 CALL csysv( 'U', 0, 0, a, 1, ip, b, 1, w, -2, info )
889 CALL chkxer( 'CSYSV ', infot, nout, lerr, ok )
890*
891* CSYSVX
892*
893 srnamt = 'CSYSVX'
894 infot = 1
895 CALL csysvx( '/', 'U', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
896 $ rcond, r1, r2, w, 1, rw, info )
897 CALL chkxer( 'CSYSVX', infot, nout, lerr, ok )
898 infot = 2
899 CALL csysvx( 'N', '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
900 $ rcond, r1, r2, w, 1, rw, info )
901 CALL chkxer( 'CSYSVX', infot, nout, lerr, ok )
902 infot = 3
903 CALL csysvx( 'N', 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1,
904 $ rcond, r1, r2, w, 1, rw, info )
905 CALL chkxer( 'CSYSVX', infot, nout, lerr, ok )
906 infot = 4
907 CALL csysvx( 'N', 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1,
908 $ rcond, r1, r2, w, 1, rw, info )
909 CALL chkxer( 'CSYSVX', infot, nout, lerr, ok )
910 infot = 6
911 CALL csysvx( 'N', 'U', 2, 0, a, 1, af, 2, ip, b, 2, x, 2,
912 $ rcond, r1, r2, w, 4, rw, info )
913 CALL chkxer( 'CSYSVX', infot, nout, lerr, ok )
914 infot = 8
915 CALL csysvx( 'N', 'U', 2, 0, a, 2, af, 1, ip, b, 2, x, 2,
916 $ rcond, r1, r2, w, 4, rw, info )
917 CALL chkxer( 'CSYSVX', infot, nout, lerr, ok )
918 infot = 11
919 CALL csysvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 1, x, 2,
920 $ rcond, r1, r2, w, 4, rw, info )
921 CALL chkxer( 'CSYSVX', infot, nout, lerr, ok )
922 infot = 13
923 CALL csysvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 1,
924 $ rcond, r1, r2, w, 4, rw, info )
925 CALL chkxer( 'CSYSVX', infot, nout, lerr, ok )
926 infot = 18
927 CALL csysvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 2,
928 $ rcond, r1, r2, w, 3, rw, info )
929 CALL chkxer( 'CSYSVX', infot, nout, lerr, ok )
930*
931 ELSE IF( lsamen( 2, c2, 'SR' ) ) THEN
932*
933* CSYSV_ROOK
934*
935 srnamt = 'CSYSV_ROOK'
936 infot = 1
937 CALL csysv_rook( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
938 CALL chkxer( 'CSYSV_ROOK', infot, nout, lerr, ok )
939 infot = 2
940 CALL csysv_rook( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
941 CALL chkxer( 'CSYSV_ROOK', infot, nout, lerr, ok )
942 infot = 3
943 CALL csysv_rook( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
944 CALL chkxer( 'CSYSV_ROOK', infot, nout, lerr, ok )
945 infot = 5
946 CALL csysv_rook( 'U', 2, 0, a, 1, ip, b, 2, w, 1, info )
947 CALL chkxer( 'CSYSV_ROOK', infot, nout, lerr, ok )
948 infot = 8
949 CALL csysv_rook( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
950 CALL chkxer( 'CSYSV_ROOK', infot, nout, lerr, ok )
951 infot = 10
952 CALL csysv_rook( 'U', 0, 0, a, 1, ip, b, 1, w, 0, info )
953 CALL chkxer( 'CSYSV_ROOK', infot, nout, lerr, ok )
954 infot = 10
955 CALL csysv_rook( 'U', 0, 0, a, 1, ip, b, 1, w, -2, info )
956 CALL chkxer( 'CSYSV_ROOK', infot, nout, lerr, ok )
957*
958 ELSE IF( lsamen( 2, c2, 'SK' ) ) THEN
959*
960* CSYSV_RK
961*
962* Test error exits of the driver that uses factorization
963* of a symmetric indefinite matrix with rook
964* (bounded Bunch-Kaufman) pivoting with the new storage
965* format for factors L ( or U) and D.
966*
967* L (or U) is stored in A, diagonal of D is stored on the
968* diagonal of A, subdiagonal of D is stored in a separate array E.
969*
970 srnamt = 'CSYSV_RK'
971 infot = 1
972 CALL csysv_rk( '/', 0, 0, a, 1, e, ip, b, 1, w, 1, info )
973 CALL chkxer( 'CSYSV_RK', infot, nout, lerr, ok )
974 infot = 2
975 CALL csysv_rk( 'U', -1, 0, a, 1, e, ip, b, 1, w, 1, info )
976 CALL chkxer( 'CSYSV_RK', infot, nout, lerr, ok )
977 infot = 3
978 CALL csysv_rk( 'U', 0, -1, a, 1, e, ip, b, 1, w, 1, info )
979 CALL chkxer( 'CSYSV_RK', infot, nout, lerr, ok )
980 infot = 5
981 CALL csysv_rk( 'U', 2, 0, a, 1, e, ip, b, 2, w, 1, info )
982 CALL chkxer( 'CSYSV_RK', infot, nout, lerr, ok )
983 infot = 9
984 CALL csysv_rk( 'U', 2, 0, a, 2, e, ip, b, 1, w, 1, info )
985 CALL chkxer( 'CSYSV_RK', infot, nout, lerr, ok )
986 infot = 11
987 CALL csysv_rk( 'U', 0, 0, a, 1, e, ip, b, 1, w, 0, info )
988 CALL chkxer( 'CSYSV_RK', infot, nout, lerr, ok )
989 infot = 11
990 CALL csysv_rk( 'U', 0, 0, a, 1, e, ip, b, 1, w, -2, info )
991 CALL chkxer( 'CSYSV_RK', infot, nout, lerr, ok )
992*
993 ELSE IF( lsamen( 2, c2, 'SP' ) ) THEN
994*
995* CSPSV
996*
997 srnamt = 'CSPSV '
998 infot = 1
999 CALL cspsv( '/', 0, 0, a, ip, b, 1, info )
1000 CALL chkxer( 'CSPSV ', infot, nout, lerr, ok )
1001 infot = 2
1002 CALL cspsv( 'U', -1, 0, a, ip, b, 1, info )
1003 CALL chkxer( 'CSPSV ', infot, nout, lerr, ok )
1004 infot = 3
1005 CALL cspsv( 'U', 0, -1, a, ip, b, 1, info )
1006 CALL chkxer( 'CSPSV ', infot, nout, lerr, ok )
1007 infot = 7
1008 CALL cspsv( 'U', 2, 0, a, ip, b, 1, info )
1009 CALL chkxer( 'CSPSV ', infot, nout, lerr, ok )
1010*
1011* CSPSVX
1012*
1013 srnamt = 'CSPSVX'
1014 infot = 1
1015 CALL cspsvx( '/', 'U', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
1016 $ r2, w, rw, info )
1017 CALL chkxer( 'CSPSVX', infot, nout, lerr, ok )
1018 infot = 2
1019 CALL cspsvx( 'N', '/', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
1020 $ r2, w, rw, info )
1021 CALL chkxer( 'CSPSVX', infot, nout, lerr, ok )
1022 infot = 3
1023 CALL cspsvx( 'N', 'U', -1, 0, a, af, ip, b, 1, x, 1, rcond, r1,
1024 $ r2, w, rw, info )
1025 CALL chkxer( 'CSPSVX', infot, nout, lerr, ok )
1026 infot = 4
1027 CALL cspsvx( 'N', 'U', 0, -1, a, af, ip, b, 1, x, 1, rcond, r1,
1028 $ r2, w, rw, info )
1029 CALL chkxer( 'CSPSVX', infot, nout, lerr, ok )
1030 infot = 9
1031 CALL cspsvx( 'N', 'U', 2, 0, a, af, ip, b, 1, x, 2, rcond, r1,
1032 $ r2, w, rw, info )
1033 CALL chkxer( 'CSPSVX', infot, nout, lerr, ok )
1034 infot = 11
1035 CALL cspsvx( 'N', 'U', 2, 0, a, af, ip, b, 2, x, 1, rcond, r1,
1036 $ r2, w, rw, info )
1037 CALL chkxer( 'CSPSVX', infot, nout, lerr, ok )
1038 END IF
1039*
1040* Print a summary line.
1041*
1042 IF( ok ) THEN
1043 WRITE( nout, fmt = 9999 )path
1044 ELSE
1045 WRITE( nout, fmt = 9998 )path
1046 END IF
1047*
1048 9999 FORMAT( 1x, a3, ' drivers passed the tests of the error exits' )
1049 9998 FORMAT( ' *** ', a3, ' drivers failed the tests of the error ',
1050 $ 'exits ***' )
1051*
1052 RETURN
1053*
1054* End of CERRVX
1055*
1056 END
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
subroutine cerrvx(path, nunit)
CERRVX
Definition cerrvx.f:55
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:162
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:370
subroutine cgesv(n, nrhs, a, lda, ipiv, b, ldb, info)
Download CGESV + dependencies <a href="http://www.netlib.org/cgi-bin/netlibfiles....
Definition cgesv.f:124
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:350
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:124
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:294
subroutine chesv_aa_2stage(uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, work, lwork, info)
CHESV_AA_2STAGE computes the solution to system of linear equations A * X = B for HE matrices
subroutine csysv_aa_2stage(uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, work, lwork, info)
CSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices
subroutine chesv_aa(uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork, info)
CHESV_AA computes the solution to system of linear equations A * X = B for HE matrices
Definition chesv_aa.f:162
subroutine csysv_aa(uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork, info)
CSYSV_AA computes the solution to system of linear equations A * X = B for SY matrices
Definition csysv_aa.f:162
subroutine chesv_rk(uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work, lwork, info)
CHESV_RK computes the solution to system of linear equations A * X = B for SY matrices
Definition chesv_rk.f:228
subroutine csysv_rk(uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work, lwork, info)
CSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices
Definition csysv_rk.f:228
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:205
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:204
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:171
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:171
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:285
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:285
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:162
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:162
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:277
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:277
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:164
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:342
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:130
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:306
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:144
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:311
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:115
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:234