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