LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
cerrsy.f
Go to the documentation of this file.
1 *> \brief \b CERRSY
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 CERRSY( 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 *> CERRSY tests the error exits for the COMPLEX routines
25 *> for symmetric indefinite matrices.
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 cerrsy( 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*2 C2
73  INTEGER I, INFO, J
74  REAL ANRM, RCOND
75 * ..
76 * .. Local Arrays ..
77  INTEGER IP( NMAX )
78  REAL R( NMAX ), R1( NMAX ), R2( NMAX )
79  COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
80  $ E( NMAX), W( 2*NMAX ), X( NMAX )
81 * ..
82 * .. External Functions ..
83  LOGICAL LSAMEN
84  EXTERNAL lsamen
85 * ..
86 * .. External Subroutines ..
87  EXTERNAL alaesm, chkxer, cspcon, csprfs, csptrf, csptri,
93 * ..
94 * .. Scalars in Common ..
95  LOGICAL LERR, OK
96  CHARACTER*32 SRNAMT
97  INTEGER INFOT, NOUT
98 * ..
99 * .. Common blocks ..
100  COMMON / infoc / infot, nout, ok, lerr
101  COMMON / srnamc / srnamt
102 * ..
103 * .. Intrinsic Functions ..
104  INTRINSIC cmplx, real
105 * ..
106 * .. Executable Statements ..
107 *
108  nout = nunit
109  WRITE( nout, fmt = * )
110  c2 = path( 2: 3 )
111 *
112 * Set the variables to innocuous values.
113 *
114  DO 20 j = 1, nmax
115  DO 10 i = 1, nmax
116  a( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
117  af( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
118  10 CONTINUE
119  b( j ) = 0.e0
120  e( j ) = 0.e0
121  r1( j ) = 0.e0
122  r2( j ) = 0.e0
123  w( j ) = 0.e0
124  x( j ) = 0.e0
125  ip( j ) = j
126  20 CONTINUE
127  anrm = 1.0
128  ok = .true.
129 *
130  IF( lsamen( 2, c2, 'SY' ) ) THEN
131 *
132 * Test error exits of the routines that use factorization
133 * of a symmetric indefinite matrix with patrial
134 * (Bunch-Kaufman) diagonal pivoting method.
135 *
136 * CSYTRF
137 *
138  srnamt = 'CSYTRF'
139  infot = 1
140  CALL csytrf( '/', 0, a, 1, ip, w, 1, info )
141  CALL chkxer( 'CSYTRF', infot, nout, lerr, ok )
142  infot = 2
143  CALL csytrf( 'U', -1, a, 1, ip, w, 1, info )
144  CALL chkxer( 'CSYTRF', infot, nout, lerr, ok )
145  infot = 4
146  CALL csytrf( 'U', 2, a, 1, ip, w, 4, info )
147  CALL chkxer( 'CSYTRF', infot, nout, lerr, ok )
148  infot = 7
149  CALL csytrf( 'U', 0, a, 1, ip, w, 0, info )
150  CALL chkxer( 'CSYTRF', infot, nout, lerr, ok )
151  infot = 7
152  CALL csytrf( 'U', 0, a, 1, ip, w, -2, info )
153  CALL chkxer( 'CSYTRF', infot, nout, lerr, ok )
154 *
155 * CSYTF2
156 *
157  srnamt = 'CSYTF2'
158  infot = 1
159  CALL csytf2( '/', 0, a, 1, ip, info )
160  CALL chkxer( 'CSYTF2', infot, nout, lerr, ok )
161  infot = 2
162  CALL csytf2( 'U', -1, a, 1, ip, info )
163  CALL chkxer( 'CSYTF2', infot, nout, lerr, ok )
164  infot = 4
165  CALL csytf2( 'U', 2, a, 1, ip, info )
166  CALL chkxer( 'CSYTF2', infot, nout, lerr, ok )
167 *
168 * CSYTRI
169 *
170  srnamt = 'CSYTRI'
171  infot = 1
172  CALL csytri( '/', 0, a, 1, ip, w, info )
173  CALL chkxer( 'CSYTRI', infot, nout, lerr, ok )
174  infot = 2
175  CALL csytri( 'U', -1, a, 1, ip, w, info )
176  CALL chkxer( 'CSYTRI', infot, nout, lerr, ok )
177  infot = 4
178  CALL csytri( 'U', 2, a, 1, ip, w, info )
179  CALL chkxer( 'CSYTRI', infot, nout, lerr, ok )
180 *
181 * CSYTRI2
182 *
183  srnamt = 'CSYTRI2'
184  infot = 1
185  CALL csytri2( '/', 0, a, 1, ip, w, 1, info )
186  CALL chkxer( 'CSYTRI2', infot, nout, lerr, ok )
187  infot = 2
188  CALL csytri2( 'U', -1, a, 1, ip, w, 1, info )
189  CALL chkxer( 'CSYTRI2', infot, nout, lerr, ok )
190  infot = 4
191  CALL csytri2( 'U', 2, a, 1, ip, w, 1, info )
192  CALL chkxer( 'CSYTRI2', infot, nout, lerr, ok )
193 *
194 * CSYTRI2X
195 *
196  srnamt = 'CSYTRI2X'
197  infot = 1
198  CALL csytri2x( '/', 0, a, 1, ip, w, 1, info )
199  CALL chkxer( 'CSYTRI2X', infot, nout, lerr, ok )
200  infot = 2
201  CALL csytri2x( 'U', -1, a, 1, ip, w, 1, info )
202  CALL chkxer( 'CSYTRI2X', infot, nout, lerr, ok )
203  infot = 4
204  CALL csytri2x( 'U', 2, a, 1, ip, w, 1, info )
205  CALL chkxer( 'CSYTRI2X', infot, nout, lerr, ok )
206 *
207 * CSYTRS
208 *
209  srnamt = 'CSYTRS'
210  infot = 1
211  CALL csytrs( '/', 0, 0, a, 1, ip, b, 1, info )
212  CALL chkxer( 'CSYTRS', infot, nout, lerr, ok )
213  infot = 2
214  CALL csytrs( 'U', -1, 0, a, 1, ip, b, 1, info )
215  CALL chkxer( 'CSYTRS', infot, nout, lerr, ok )
216  infot = 3
217  CALL csytrs( 'U', 0, -1, a, 1, ip, b, 1, info )
218  CALL chkxer( 'CSYTRS', infot, nout, lerr, ok )
219  infot = 5
220  CALL csytrs( 'U', 2, 1, a, 1, ip, b, 2, info )
221  CALL chkxer( 'CSYTRS', infot, nout, lerr, ok )
222  infot = 8
223  CALL csytrs( 'U', 2, 1, a, 2, ip, b, 1, info )
224  CALL chkxer( 'CSYTRS', infot, nout, lerr, ok )
225 *
226 * CSYRFS
227 *
228  srnamt = 'CSYRFS'
229  infot = 1
230  CALL csyrfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
231  $ r, info )
232  CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
233  infot = 2
234  CALL csyrfs( 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
235  $ w, r, info )
236  CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
237  infot = 3
238  CALL csyrfs( 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
239  $ w, r, info )
240  CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
241  infot = 5
242  CALL csyrfs( 'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
243  $ r, info )
244  CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
245  infot = 7
246  CALL csyrfs( 'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
247  $ r, info )
248  CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
249  infot = 10
250  CALL csyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
251  $ r, info )
252  CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
253  infot = 12
254  CALL csyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
255  $ r, info )
256  CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
257 *
258 * CSYCON
259 *
260  srnamt = 'CSYCON'
261  infot = 1
262  CALL csycon( '/', 0, a, 1, ip, anrm, rcond, w, info )
263  CALL chkxer( 'CSYCON', infot, nout, lerr, ok )
264  infot = 2
265  CALL csycon( 'U', -1, a, 1, ip, anrm, rcond, w, info )
266  CALL chkxer( 'CSYCON', infot, nout, lerr, ok )
267  infot = 4
268  CALL csycon( 'U', 2, a, 1, ip, anrm, rcond, w, info )
269  CALL chkxer( 'CSYCON', infot, nout, lerr, ok )
270  infot = 6
271  CALL csycon( 'U', 1, a, 1, ip, -anrm, rcond, w, info )
272  CALL chkxer( 'CSYCON', infot, nout, lerr, ok )
273 *
274  ELSE IF( lsamen( 2, c2, 'SR' ) ) THEN
275 *
276 * Test error exits of the routines that use factorization
277 * of a symmetric indefinite matrix with rook
278 * (bounded Bunch-Kaufman) diagonal pivoting method.
279 *
280 * CSYTRF_ROOK
281 *
282  srnamt = 'CSYTRF_ROOK'
283  infot = 1
284  CALL csytrf_rook( '/', 0, a, 1, ip, w, 1, info )
285  CALL chkxer( 'CSYTRF_ROOK', infot, nout, lerr, ok )
286  infot = 2
287  CALL csytrf_rook( 'U', -1, a, 1, ip, w, 1, info )
288  CALL chkxer( 'CSYTRF_ROOK', infot, nout, lerr, ok )
289  infot = 4
290  CALL csytrf_rook( 'U', 2, a, 1, ip, w, 4, info )
291  CALL chkxer( 'CSYTRF_ROOK', infot, nout, lerr, ok )
292  infot = 7
293  CALL csytrf_rook( 'U', 0, a, 1, ip, w, 0, info )
294  CALL chkxer( 'CSYTRF_ROOK', infot, nout, lerr, ok )
295  infot = 7
296  CALL csytrf_rook( 'U', 0, a, 1, ip, w, -2, info )
297  CALL chkxer( 'CSYTRF_ROOK', infot, nout, lerr, ok )
298 *
299 * CSYTF2_ROOK
300 *
301  srnamt = 'CSYTF2_ROOK'
302  infot = 1
303  CALL csytf2_rook( '/', 0, a, 1, ip, info )
304  CALL chkxer( 'CSYTF2_ROOK', infot, nout, lerr, ok )
305  infot = 2
306  CALL csytf2_rook( 'U', -1, a, 1, ip, info )
307  CALL chkxer( 'CSYTF2_ROOK', infot, nout, lerr, ok )
308  infot = 4
309  CALL csytf2_rook( 'U', 2, a, 1, ip, info )
310  CALL chkxer( 'CSYTF2_ROOK', infot, nout, lerr, ok )
311 *
312 * CSYTRI_ROOK
313 *
314  srnamt = 'CSYTRI_ROOK'
315  infot = 1
316  CALL csytri_rook( '/', 0, a, 1, ip, w, info )
317  CALL chkxer( 'CSYTRI_ROOK', infot, nout, lerr, ok )
318  infot = 2
319  CALL csytri_rook( 'U', -1, a, 1, ip, w, info )
320  CALL chkxer( 'CSYTRI_ROOK', infot, nout, lerr, ok )
321  infot = 4
322  CALL csytri_rook( 'U', 2, a, 1, ip, w, info )
323  CALL chkxer( 'CSYTRI_ROOK', infot, nout, lerr, ok )
324 *
325 * CSYTRS_ROOK
326 *
327  srnamt = 'CSYTRS_ROOK'
328  infot = 1
329  CALL csytrs_rook( '/', 0, 0, a, 1, ip, b, 1, info )
330  CALL chkxer( 'CSYTRS_ROOK', infot, nout, lerr, ok )
331  infot = 2
332  CALL csytrs_rook( 'U', -1, 0, a, 1, ip, b, 1, info )
333  CALL chkxer( 'CSYTRS_ROOK', infot, nout, lerr, ok )
334  infot = 3
335  CALL csytrs_rook( 'U', 0, -1, a, 1, ip, b, 1, info )
336  CALL chkxer( 'CSYTRS_ROOK', infot, nout, lerr, ok )
337  infot = 5
338  CALL csytrs_rook( 'U', 2, 1, a, 1, ip, b, 2, info )
339  CALL chkxer( 'CSYTRS_ROOK', infot, nout, lerr, ok )
340  infot = 8
341  CALL csytrs_rook( 'U', 2, 1, a, 2, ip, b, 1, info )
342  CALL chkxer( 'CSYTRS_ROOK', infot, nout, lerr, ok )
343 *
344 * CSYCON_ROOK
345 *
346  srnamt = 'CSYCON_ROOK'
347  infot = 1
348  CALL csycon_rook( '/', 0, a, 1, ip, anrm, rcond, w, info )
349  CALL chkxer( 'CSYCON_ROOK', infot, nout, lerr, ok )
350  infot = 2
351  CALL csycon_rook( 'U', -1, a, 1, ip, anrm, rcond, w, info )
352  CALL chkxer( 'CSYCON_ROOK', infot, nout, lerr, ok )
353  infot = 4
354  CALL csycon_rook( 'U', 2, a, 1, ip, anrm, rcond, w, info )
355  CALL chkxer( 'CSYCON_ROOK', infot, nout, lerr, ok )
356  infot = 6
357  CALL csycon_rook( 'U', 1, a, 1, ip, -anrm, rcond, w, info )
358  CALL chkxer( 'CSYCON_ROOK', infot, nout, lerr, ok )
359 *
360  ELSE IF( lsamen( 2, c2, 'SK' ) ) THEN
361 *
362 * Test error exits of the routines that use factorization
363 * of a symmetric indefinite matrix with rook
364 * (bounded Bunch-Kaufman) pivoting with the new storage
365 * format for factors L ( or U) and D.
366 *
367 * L (or U) is stored in A, diagonal of D is stored on the
368 * diagonal of A, subdiagonal of D is stored in a separate array E.
369 *
370 * CSYTRF_RK
371 *
372  srnamt = 'CSYTRF_RK'
373  infot = 1
374  CALL csytrf_rk( '/', 0, a, 1, e, ip, w, 1, info )
375  CALL chkxer( 'CSYTRF_RK', infot, nout, lerr, ok )
376  infot = 2
377  CALL csytrf_rk( 'U', -1, a, 1, e, ip, w, 1, info )
378  CALL chkxer( 'CSYTRF_RK', infot, nout, lerr, ok )
379  infot = 4
380  CALL csytrf_rk( 'U', 2, a, 1, e, ip, w, 4, info )
381  CALL chkxer( 'CSYTRF_RK', infot, nout, lerr, ok )
382  infot = 8
383  CALL csytrf_rk( 'U', 0, a, 1, e, ip, w, 0, info )
384  CALL chkxer( 'CSYTRF_RK', infot, nout, lerr, ok )
385  infot = 8
386  CALL csytrf_rk( 'U', 0, a, 1, e, ip, w, -2, info )
387  CALL chkxer( 'CSYTRF_RK', infot, nout, lerr, ok )
388 *
389 * CSYTF2_RK
390 *
391  srnamt = 'CSYTF2_RK'
392  infot = 1
393  CALL csytf2_rk( '/', 0, a, 1, e, ip, info )
394  CALL chkxer( 'CSYTF2_RK', infot, nout, lerr, ok )
395  infot = 2
396  CALL csytf2_rk( 'U', -1, a, 1, e, ip, info )
397  CALL chkxer( 'CSYTF2_RK', infot, nout, lerr, ok )
398  infot = 4
399  CALL csytf2_rk( 'U', 2, a, 1, e, ip, info )
400  CALL chkxer( 'CSYTF2_RK', infot, nout, lerr, ok )
401 *
402 * CSYTRI_3
403 *
404  srnamt = 'CSYTRI_3'
405  infot = 1
406  CALL csytri_3( '/', 0, a, 1, e, ip, w, 1, info )
407  CALL chkxer( 'CSYTRI_3', infot, nout, lerr, ok )
408  infot = 2
409  CALL csytri_3( 'U', -1, a, 1, e, ip, w, 1, info )
410  CALL chkxer( 'CSYTRI_3', infot, nout, lerr, ok )
411  infot = 4
412  CALL csytri_3( 'U', 2, a, 1, e, ip, w, 1, info )
413  CALL chkxer( 'CSYTRI_3', infot, nout, lerr, ok )
414  infot = 8
415  CALL csytri_3( 'U', 0, a, 1, e, ip, w, 0, info )
416  CALL chkxer( 'CSYTRI_3', infot, nout, lerr, ok )
417  infot = 8
418  CALL csytri_3( 'U', 0, a, 1, e, ip, w, -2, info )
419  CALL chkxer( 'CSYTRI_3', infot, nout, lerr, ok )
420 *
421 * CSYTRI_3X
422 *
423  srnamt = 'CSYTRI_3X'
424  infot = 1
425  CALL csytri_3x( '/', 0, a, 1, e, ip, w, 1, info )
426  CALL chkxer( 'CSYTRI_3X', infot, nout, lerr, ok )
427  infot = 2
428  CALL csytri_3x( 'U', -1, a, 1, e, ip, w, 1, info )
429  CALL chkxer( 'CSYTRI_3X', infot, nout, lerr, ok )
430  infot = 4
431  CALL csytri_3x( 'U', 2, a, 1, e, ip, w, 1, info )
432  CALL chkxer( 'CSYTRI_3X', infot, nout, lerr, ok )
433 *
434 * CSYTRS_3
435 *
436  srnamt = 'CSYTRS_3'
437  infot = 1
438  CALL csytrs_3( '/', 0, 0, a, 1, e, ip, b, 1, info )
439  CALL chkxer( 'CSYTRS_3', infot, nout, lerr, ok )
440  infot = 2
441  CALL csytrs_3( 'U', -1, 0, a, 1, e, ip, b, 1, info )
442  CALL chkxer( 'CSYTRS_3', infot, nout, lerr, ok )
443  infot = 3
444  CALL csytrs_3( 'U', 0, -1, a, 1, e, ip, b, 1, info )
445  CALL chkxer( 'CSYTRS_3', infot, nout, lerr, ok )
446  infot = 5
447  CALL csytrs_3( 'U', 2, 1, a, 1, e, ip, b, 2, info )
448  CALL chkxer( 'CSYTRS_3', infot, nout, lerr, ok )
449  infot = 9
450  CALL csytrs_3( 'U', 2, 1, a, 2, e, ip, b, 1, info )
451  CALL chkxer( 'CSYTRS_3', infot, nout, lerr, ok )
452 *
453 * CSYCON_3
454 *
455  srnamt = 'CSYCON_3'
456  infot = 1
457  CALL csycon_3( '/', 0, a, 1, e, ip, anrm, rcond, w, info )
458  CALL chkxer( 'CSYCON_3', infot, nout, lerr, ok )
459  infot = 2
460  CALL csycon_3( 'U', -1, a, 1, e, ip, anrm, rcond, w, info )
461  CALL chkxer( 'CSYCON_3', infot, nout, lerr, ok )
462  infot = 4
463  CALL csycon_3( 'U', 2, a, 1, e, ip, anrm, rcond, w, info )
464  CALL chkxer( 'CSYCON_3', infot, nout, lerr, ok )
465  infot = 7
466  CALL csycon_3( 'U', 1, a, 1, e, ip, -1.0e0, rcond, w, info)
467  CALL chkxer( 'CSYCON_3', infot, nout, lerr, ok )
468 *
469  ELSE IF( lsamen( 2, c2, 'SP' ) ) THEN
470 *
471 * Test error exits of the routines that use factorization
472 * of a symmetric indefinite packed matrix with patrial
473 * (Bunch-Kaufman) diagonal pivoting method.
474 *
475 * CSPTRF
476 *
477  srnamt = 'CSPTRF'
478  infot = 1
479  CALL csptrf( '/', 0, a, ip, info )
480  CALL chkxer( 'CSPTRF', infot, nout, lerr, ok )
481  infot = 2
482  CALL csptrf( 'U', -1, a, ip, info )
483  CALL chkxer( 'CSPTRF', infot, nout, lerr, ok )
484 *
485 * CSPTRI
486 *
487  srnamt = 'CSPTRI'
488  infot = 1
489  CALL csptri( '/', 0, a, ip, w, info )
490  CALL chkxer( 'CSPTRI', infot, nout, lerr, ok )
491  infot = 2
492  CALL csptri( 'U', -1, a, ip, w, info )
493  CALL chkxer( 'CSPTRI', infot, nout, lerr, ok )
494 *
495 * CSPTRS
496 *
497  srnamt = 'CSPTRS'
498  infot = 1
499  CALL csptrs( '/', 0, 0, a, ip, b, 1, info )
500  CALL chkxer( 'CSPTRS', infot, nout, lerr, ok )
501  infot = 2
502  CALL csptrs( 'U', -1, 0, a, ip, b, 1, info )
503  CALL chkxer( 'CSPTRS', infot, nout, lerr, ok )
504  infot = 3
505  CALL csptrs( 'U', 0, -1, a, ip, b, 1, info )
506  CALL chkxer( 'CSPTRS', infot, nout, lerr, ok )
507  infot = 7
508  CALL csptrs( 'U', 2, 1, a, ip, b, 1, info )
509  CALL chkxer( 'CSPTRS', infot, nout, lerr, ok )
510 *
511 * CSPRFS
512 *
513  srnamt = 'CSPRFS'
514  infot = 1
515  CALL csprfs( '/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
516  $ info )
517  CALL chkxer( 'CSPRFS', infot, nout, lerr, ok )
518  infot = 2
519  CALL csprfs( 'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
520  $ info )
521  CALL chkxer( 'CSPRFS', infot, nout, lerr, ok )
522  infot = 3
523  CALL csprfs( 'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
524  $ info )
525  CALL chkxer( 'CSPRFS', infot, nout, lerr, ok )
526  infot = 8
527  CALL csprfs( 'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
528  $ info )
529  CALL chkxer( 'CSPRFS', infot, nout, lerr, ok )
530  infot = 10
531  CALL csprfs( 'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
532  $ info )
533  CALL chkxer( 'CSPRFS', infot, nout, lerr, ok )
534 *
535 * CSPCON
536 *
537  srnamt = 'CSPCON'
538  infot = 1
539  CALL cspcon( '/', 0, a, ip, anrm, rcond, w, info )
540  CALL chkxer( 'CSPCON', infot, nout, lerr, ok )
541  infot = 2
542  CALL cspcon( 'U', -1, a, ip, anrm, rcond, w, info )
543  CALL chkxer( 'CSPCON', infot, nout, lerr, ok )
544  infot = 5
545  CALL cspcon( 'U', 1, a, ip, -anrm, rcond, w, info )
546  CALL chkxer( 'CSPCON', infot, nout, lerr, ok )
547 *
548  ELSE IF( lsamen( 2, c2, 'SA' ) ) THEN
549 *
550 * Test error exits of the routines that use factorization
551 * of a symmetric indefinite matrix with Aasen's algorithm
552 *
553 * CSYTRF_AA
554 *
555  srnamt = 'CSYTRF_AA'
556  infot = 1
557  CALL csytrf_aa( '/', 0, a, 1, ip, w, 1, info )
558  CALL chkxer( 'CSYTRF_AA', infot, nout, lerr, ok )
559  infot = 2
560  CALL csytrf_aa( 'U', -1, a, 1, ip, w, 1, info )
561  CALL chkxer( 'CSYTRF_AA', infot, nout, lerr, ok )
562  infot = 4
563  CALL csytrf_aa( 'U', 2, a, 1, ip, w, 4, info )
564  CALL chkxer( 'CSYTRF_AA', infot, nout, lerr, ok )
565  infot = 7
566  CALL csytrf_aa( 'U', 0, a, 1, ip, w, 0, info )
567  CALL chkxer( 'CSYTRF_AA', infot, nout, lerr, ok )
568  infot = 7
569  CALL csytrf_aa( 'U', 0, a, 1, ip, w, -2, info )
570  CALL chkxer( 'CSYTRF_AA', infot, nout, lerr, ok )
571 *
572 * CSYTRS_AA
573 *
574  srnamt = 'CSYTRS_AA'
575  infot = 1
576  CALL csytrs_aa( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
577  CALL chkxer( 'CSYTRS_AA', infot, nout, lerr, ok )
578  infot = 2
579  CALL csytrs_aa( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
580  CALL chkxer( 'CSYTRS_AA', infot, nout, lerr, ok )
581  infot = 3
582  CALL csytrs_aa( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
583  CALL chkxer( 'CSYTRS_AA', infot, nout, lerr, ok )
584  infot = 5
585  CALL csytrs_aa( 'U', 2, 1, a, 1, ip, b, 2, w, 1, info )
586  CALL chkxer( 'CSYTRS_AA', infot, nout, lerr, ok )
587  infot = 8
588  CALL csytrs_aa( 'U', 2, 1, a, 2, ip, b, 1, w, 1, info )
589  CALL chkxer( 'CSYTRS_AA', infot, nout, lerr, ok )
590  infot = 10
591  CALL csytrs_aa( 'U', 0, 1, a, 1, ip, b, 1, w, 0, info )
592  CALL chkxer( 'CSYTRS_AA', infot, nout, lerr, ok )
593  infot = 10
594  CALL csytrs_aa( 'U', 0, 1, a, 1, ip, b, 1, w, -2, info )
595  CALL chkxer( 'CSYTRS_AA', infot, nout, lerr, ok )
596 *
597  ELSE IF( lsamen( 2, c2, 'S2' ) ) THEN
598 *
599 * Test error exits of the routines that use factorization
600 * of a symmetric indefinite matrix with Aasen's algorithm.
601 *
602 * CSYTRF_AA_2STAGE
603 *
604  srnamt = 'CSYTRF_AA_2STAGE'
605  infot = 1
606  CALL csytrf_aa_2stage( '/', 0, a, 1, a, 1, ip, ip, w, 1,
607  $ info )
608  CALL chkxer( 'CSYTRF_AA_2STAGE', infot, nout, lerr, ok )
609  infot = 2
610  CALL csytrf_aa_2stage( 'U', -1, a, 1, a, 1, ip, ip, w, 1,
611  $ info )
612  CALL chkxer( 'CSYTRF_AA_2STAGE', infot, nout, lerr, ok )
613  infot = 4
614  CALL csytrf_aa_2stage( 'U', 2, a, 1, a, 2, ip, ip, w, 1,
615  $ info )
616  CALL chkxer( 'CSYTRF_AA_2STAGE', infot, nout, lerr, ok )
617  infot = 6
618  CALL csytrf_aa_2stage( 'U', 2, a, 2, a, 1, ip, ip, w, 1,
619  $ info )
620  CALL chkxer( 'CSYTRF_AA_2STAGE', infot, nout, lerr, ok )
621  infot = 10
622  CALL csytrf_aa_2stage( 'U', 2, a, 2, a, 8, ip, ip, w, 0,
623  $ info )
624  CALL chkxer( 'CSYTRF_AA_2STAGE', infot, nout, lerr, ok )
625 *
626 * CHETRS_AA_2STAGE
627 *
628  srnamt = 'CSYTRS_AA_2STAGE'
629  infot = 1
630  CALL csytrs_aa_2stage( '/', 0, 0, a, 1, a, 1, ip, ip,
631  $ b, 1, info )
632  CALL chkxer( 'CSYTRS_AA_2STAGE', infot, nout, lerr, ok )
633  infot = 2
634  CALL csytrs_aa_2stage( 'U', -1, 0, a, 1, a, 1, ip, ip,
635  $ b, 1, info )
636  CALL chkxer( 'CSYTRS_AA_2STAGE', infot, nout, lerr, ok )
637  infot = 3
638  CALL csytrs_aa_2stage( 'U', 0, -1, a, 1, a, 1, ip, ip,
639  $ b, 1, info )
640  CALL chkxer( 'CSYTRS_AA_2STAGE', infot, nout, lerr, ok )
641  infot = 5
642  CALL csytrs_aa_2stage( 'U', 2, 1, a, 1, a, 1, ip, ip,
643  $ b, 1, info )
644  CALL chkxer( 'CSYTRS_AA_2STAGE', infot, nout, lerr, ok )
645  infot = 7
646  CALL csytrs_aa_2stage( 'U', 2, 1, a, 2, a, 1, ip, ip,
647  $ b, 1, info )
648  CALL chkxer( 'CSYTRS_AA_2STAGE', infot, nout, lerr, ok )
649  infot = 11
650  CALL csytrs_aa_2stage( 'U', 2, 1, a, 2, a, 8, ip, ip,
651  $ b, 1, info )
652  CALL chkxer( 'CSYTRS_AA_STAGE', infot, nout, lerr, ok )
653 *
654  END IF
655 *
656 * Print a summary line.
657 *
658  CALL alaesm( path, ok, nout )
659 *
660  RETURN
661 *
662 * End of CERRSY
663 *
664  END
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
subroutine cerrsy(PATH, NUNIT)
CERRSY
Definition: cerrsy.f:55
subroutine csprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CSPRFS
Definition: csprfs.f:180
subroutine csptri(UPLO, N, AP, IPIV, WORK, INFO)
CSPTRI
Definition: csptri.f:109
subroutine csptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
CSPTRS
Definition: csptrs.f:115
subroutine csptrf(UPLO, N, AP, IPIV, INFO)
CSPTRF
Definition: csptrf.f:158
subroutine cspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
CSPCON
Definition: cspcon.f:118
subroutine csytf2(UPLO, N, A, LDA, IPIV, INFO)
CSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
Definition: csytf2.f:191
subroutine csytrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CSYTRS_AA
Definition: csytrs_aa.f:131
subroutine csyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CSYRFS
Definition: csyrfs.f:192
subroutine csycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON_ROOK
Definition: csycon_rook.f:139
subroutine csytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRI2
Definition: csytri2.f:127
subroutine csytri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
CSYTRI_3
Definition: csytri_3.f:170
subroutine csytf2_rk(UPLO, N, A, LDA, E, IPIV, INFO)
CSYTF2_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch...
Definition: csytf2_rk.f:241
subroutine csycon_3(UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON_3
Definition: csycon_3.f:166
subroutine csytrf_aa_2stage(UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, WORK, LWORK, INFO)
CSYTRF_AA_2STAGE
subroutine csytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CSYTRS_ROOK
Definition: csytrs_rook.f:136
subroutine csytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF_AA
Definition: csytrf_aa.f:132
subroutine csycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON
Definition: csycon.f:125
subroutine csytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
CSYTRI
Definition: csytri.f:114
subroutine csytf2_rook(UPLO, N, A, LDA, IPIV, INFO)
CSYTF2_ROOK computes the factorization of a complex symmetric indefinite matrix using the bounded Bun...
Definition: csytf2_rook.f:194
subroutine csytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF_ROOK
Definition: csytrf_rook.f:208
subroutine csytri_3x(UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO)
CSYTRI_3X
Definition: csytri_3x.f:159
subroutine csytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CSYTRS
Definition: csytrs.f:120
subroutine csytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF
Definition: csytrf.f:182
subroutine csytri2x(UPLO, N, A, LDA, IPIV, WORK, NB, INFO)
CSYTRI2X
Definition: csytri2x.f:120
subroutine csytrf_rk(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
CSYTRF_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch...
Definition: csytrf_rk.f:259
subroutine csytrs_aa_2stage(UPLO, N, NRHS, A, LDA, TB, LTB, IPIV, IPIV2, B, LDB, INFO)
CSYTRS_AA_2STAGE
subroutine csytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
CSYTRI_ROOK
Definition: csytri_rook.f:129
subroutine csytrs_3(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO)
CSYTRS_3
Definition: csytrs_3.f:165