LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
serrsy.f
Go to the documentation of this file.
1 *> \brief \b SERRSY
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 SERRSY( 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 *> SERRSY tests the error exits for the REAL 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 single_lin
52 *
53 * =====================================================================
54  SUBROUTINE serrsy( 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 ), IW( NMAX )
78  REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
79  $ E( NMAX ), R1( NMAX ), R2( NMAX ), W( 3*NMAX ),
80  $ X( NMAX )
81 * ..
82 * .. External Functions ..
83  LOGICAL LSAMEN
84  EXTERNAL lsamen
85 * ..
86 * .. External Subroutines ..
87  EXTERNAL alaesm, chkxer, sspcon, ssprfs, ssptrf, ssptri,
94 * ..
95 * .. Scalars in Common ..
96  LOGICAL LERR, OK
97  CHARACTER*32 SRNAMT
98  INTEGER INFOT, NOUT
99 * ..
100 * .. Common blocks ..
101  COMMON / infoc / infot, nout, ok, lerr
102  COMMON / srnamc / srnamt
103 * ..
104 * .. Intrinsic Functions ..
105  INTRINSIC real
106 * ..
107 * .. Executable Statements ..
108 *
109  nout = nunit
110  WRITE( nout, fmt = * )
111  c2 = path( 2: 3 )
112 *
113 * Set the variables to innocuous values.
114 *
115  DO 20 j = 1, nmax
116  DO 10 i = 1, nmax
117  a( i, j ) = 1. / real( i+j )
118  af( i, j ) = 1. / real( i+j )
119  10 CONTINUE
120  b( j ) = 0.e+0
121  e( j ) = 0.e+0
122  r1( j ) = 0.e+0
123  r2( j ) = 0.e+0
124  w( j ) = 0.e+0
125  x( j ) = 0.e+0
126  ip( j ) = j
127  iw( j ) = j
128  20 CONTINUE
129  anrm = 1.0
130  rcond = 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) pivoting.
138 *
139 * SSYTRF
140 *
141  srnamt = 'SSYTRF'
142  infot = 1
143  CALL ssytrf( '/', 0, a, 1, ip, w, 1, info )
144  CALL chkxer( 'SSYTRF', infot, nout, lerr, ok )
145  infot = 2
146  CALL ssytrf( 'U', -1, a, 1, ip, w, 1, info )
147  CALL chkxer( 'SSYTRF', infot, nout, lerr, ok )
148  infot = 4
149  CALL ssytrf( 'U', 2, a, 1, ip, w, 4, info )
150  CALL chkxer( 'SSYTRF', infot, nout, lerr, ok )
151  infot = 7
152  CALL ssytrf( 'U', 0, a, 1, ip, w, 0, info )
153  CALL chkxer( 'SSYTRF', infot, nout, lerr, ok )
154  infot = 7
155  CALL ssytrf( 'U', 0, a, 1, ip, w, -2, info )
156  CALL chkxer( 'SSYTRF', infot, nout, lerr, ok )
157 *
158 * SSYTF2
159 *
160  srnamt = 'SSYTF2'
161  infot = 1
162  CALL ssytf2( '/', 0, a, 1, ip, info )
163  CALL chkxer( 'SSYTF2', infot, nout, lerr, ok )
164  infot = 2
165  CALL ssytf2( 'U', -1, a, 1, ip, info )
166  CALL chkxer( 'SSYTF2', infot, nout, lerr, ok )
167  infot = 4
168  CALL ssytf2( 'U', 2, a, 1, ip, info )
169  CALL chkxer( 'SSYTF2', infot, nout, lerr, ok )
170 *
171 * SSYTRI
172 *
173  srnamt = 'SSYTRI'
174  infot = 1
175  CALL ssytri( '/', 0, a, 1, ip, w, info )
176  CALL chkxer( 'SSYTRI', infot, nout, lerr, ok )
177  infot = 2
178  CALL ssytri( 'U', -1, a, 1, ip, w, info )
179  CALL chkxer( 'SSYTRI', infot, nout, lerr, ok )
180  infot = 4
181  CALL ssytri( 'U', 2, a, 1, ip, w, info )
182  CALL chkxer( 'SSYTRI', infot, nout, lerr, ok )
183 *
184 * SSYTRI2
185 *
186  srnamt = 'SSYTRI2'
187  infot = 1
188  CALL ssytri2( '/', 0, a, 1, ip, w, iw(1), info )
189  CALL chkxer( 'SSYTRI2', infot, nout, lerr, ok )
190  infot = 2
191  CALL ssytri2( 'U', -1, a, 1, ip, w, iw(1), info )
192  CALL chkxer( 'SSYTRI2', infot, nout, lerr, ok )
193  infot = 4
194  CALL ssytri2( 'U', 2, a, 1, ip, w, iw(1), info )
195  CALL chkxer( 'SSYTRI2', infot, nout, lerr, ok )
196 *
197 * SSYTRI2X
198 *
199  srnamt = 'SSYTRI2X'
200  infot = 1
201  CALL ssytri2x( '/', 0, a, 1, ip, w, 1, info )
202  CALL chkxer( 'SSYTRI2X', infot, nout, lerr, ok )
203  infot = 2
204  CALL ssytri2x( 'U', -1, a, 1, ip, w, 1, info )
205  CALL chkxer( 'SSYTRI2X', infot, nout, lerr, ok )
206  infot = 4
207  CALL ssytri2x( 'U', 2, a, 1, ip, w, 1, info )
208  CALL chkxer( 'SSYTRI2X', infot, nout, lerr, ok )
209 *
210 * SSYTRS
211 *
212  srnamt = 'SSYTRS'
213  infot = 1
214  CALL ssytrs( '/', 0, 0, a, 1, ip, b, 1, info )
215  CALL chkxer( 'SSYTRS', infot, nout, lerr, ok )
216  infot = 2
217  CALL ssytrs( 'U', -1, 0, a, 1, ip, b, 1, info )
218  CALL chkxer( 'SSYTRS', infot, nout, lerr, ok )
219  infot = 3
220  CALL ssytrs( 'U', 0, -1, a, 1, ip, b, 1, info )
221  CALL chkxer( 'SSYTRS', infot, nout, lerr, ok )
222  infot = 5
223  CALL ssytrs( 'U', 2, 1, a, 1, ip, b, 2, info )
224  CALL chkxer( 'SSYTRS', infot, nout, lerr, ok )
225  infot = 8
226  CALL ssytrs( 'U', 2, 1, a, 2, ip, b, 1, info )
227  CALL chkxer( 'SSYTRS', infot, nout, lerr, ok )
228 *
229 * SSYRFS
230 *
231  srnamt = 'SSYRFS'
232  infot = 1
233  CALL ssyrfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
234  $ iw, info )
235  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
236  infot = 2
237  CALL ssyrfs( 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
238  $ w, iw, info )
239  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
240  infot = 3
241  CALL ssyrfs( 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
242  $ w, iw, info )
243  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
244  infot = 5
245  CALL ssyrfs( 'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
246  $ iw, info )
247  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
248  infot = 7
249  CALL ssyrfs( 'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
250  $ iw, info )
251  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
252  infot = 10
253  CALL ssyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
254  $ iw, info )
255  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
256  infot = 12
257  CALL ssyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
258  $ iw, info )
259  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
260 *
261 * SSYCON
262 *
263  srnamt = 'SSYCON'
264  infot = 1
265  CALL ssycon( '/', 0, a, 1, ip, anrm, rcond, w, iw, info )
266  CALL chkxer( 'SSYCON', infot, nout, lerr, ok )
267  infot = 2
268  CALL ssycon( 'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
269  CALL chkxer( 'SSYCON', infot, nout, lerr, ok )
270  infot = 4
271  CALL ssycon( 'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
272  CALL chkxer( 'SSYCON', infot, nout, lerr, ok )
273  infot = 6
274  CALL ssycon( 'U', 1, a, 1, ip, -1.0, rcond, w, iw, info )
275  CALL chkxer( 'SSYCON', 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) pivoting.
282 *
283 * SSYTRF_ROOK
284 *
285  srnamt = 'SSYTRF_ROOK'
286  infot = 1
287  CALL ssytrf_rook( '/', 0, a, 1, ip, w, 1, info )
288  CALL chkxer( 'SSYTRF_ROOK', infot, nout, lerr, ok )
289  infot = 2
290  CALL ssytrf_rook( 'U', -1, a, 1, ip, w, 1, info )
291  CALL chkxer( 'SSYTRF_ROOK', infot, nout, lerr, ok )
292  infot = 4
293  CALL ssytrf_rook( 'U', 2, a, 1, ip, w, 4, info )
294  CALL chkxer( 'SSYTRF_ROOK', infot, nout, lerr, ok )
295  infot = 7
296  CALL ssytrf_rook( 'U', 0, a, 1, ip, w, 0, info )
297  CALL chkxer( 'SSYTRF_ROOK', infot, nout, lerr, ok )
298  infot = 7
299  CALL ssytrf_rook( 'U', 0, a, 1, ip, w, -2, info )
300  CALL chkxer( 'SSYTRF_ROOK', infot, nout, lerr, ok )
301 *
302 * SSYTF2_ROOK
303 *
304  srnamt = 'SSYTF2_ROOK'
305  infot = 1
306  CALL ssytf2_rook( '/', 0, a, 1, ip, info )
307  CALL chkxer( 'SSYTF2_ROOK', infot, nout, lerr, ok )
308  infot = 2
309  CALL ssytf2_rook( 'U', -1, a, 1, ip, info )
310  CALL chkxer( 'SSYTF2_ROOK', infot, nout, lerr, ok )
311  infot = 4
312  CALL ssytf2_rook( 'U', 2, a, 1, ip, info )
313  CALL chkxer( 'SSYTF2_ROOK', infot, nout, lerr, ok )
314 *
315 * SSYTRI_ROOK
316 *
317  srnamt = 'SSYTRI_ROOK'
318  infot = 1
319  CALL ssytri_rook( '/', 0, a, 1, ip, w, info )
320  CALL chkxer( 'SSYTRI_ROOK', infot, nout, lerr, ok )
321  infot = 2
322  CALL ssytri_rook( 'U', -1, a, 1, ip, w, info )
323  CALL chkxer( 'SSYTRI_ROOK', infot, nout, lerr, ok )
324  infot = 4
325  CALL ssytri_rook( 'U', 2, a, 1, ip, w, info )
326  CALL chkxer( 'SSYTRI_ROOK', infot, nout, lerr, ok )
327 *
328 * SSYTRS_ROOK
329 *
330  srnamt = 'SSYTRS_ROOK'
331  infot = 1
332  CALL ssytrs_rook( '/', 0, 0, a, 1, ip, b, 1, info )
333  CALL chkxer( 'SSYTRS_ROOK', infot, nout, lerr, ok )
334  infot = 2
335  CALL ssytrs_rook( 'U', -1, 0, a, 1, ip, b, 1, info )
336  CALL chkxer( 'SSYTRS_ROOK', infot, nout, lerr, ok )
337  infot = 3
338  CALL ssytrs_rook( 'U', 0, -1, a, 1, ip, b, 1, info )
339  CALL chkxer( 'SSYTRS_ROOK', infot, nout, lerr, ok )
340  infot = 5
341  CALL ssytrs_rook( 'U', 2, 1, a, 1, ip, b, 2, info )
342  CALL chkxer( 'SSYTRS_ROOK', infot, nout, lerr, ok )
343  infot = 8
344  CALL ssytrs_rook( 'U', 2, 1, a, 2, ip, b, 1, info )
345  CALL chkxer( 'SSYTRS_ROOK', infot, nout, lerr, ok )
346 *
347 * SSYCON_ROOK
348 *
349  srnamt = 'SSYCON_ROOK'
350  infot = 1
351  CALL ssycon_rook( '/', 0, a, 1, ip, anrm, rcond, w, iw, info )
352  CALL chkxer( 'SSYCON_ROOK', infot, nout, lerr, ok )
353  infot = 2
354  CALL ssycon_rook( 'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
355  CALL chkxer( 'SSYCON_ROOK', infot, nout, lerr, ok )
356  infot = 4
357  CALL ssycon_rook( 'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
358  CALL chkxer( 'SSYCON_ROOK', infot, nout, lerr, ok )
359  infot = 6
360  CALL ssycon_rook( 'U', 1, a, 1, ip, -1.0, rcond, w, iw, info )
361  CALL chkxer( 'SSYCON_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 * SSYTRF_RK
374 *
375  srnamt = 'SSYTRF_RK'
376  infot = 1
377  CALL ssytrf_rk( '/', 0, a, 1, e, ip, w, 1, info )
378  CALL chkxer( 'SSYTRF_RK', infot, nout, lerr, ok )
379  infot = 2
380  CALL ssytrf_rk( 'U', -1, a, 1, e, ip, w, 1, info )
381  CALL chkxer( 'SSYTRF_RK', infot, nout, lerr, ok )
382  infot = 4
383  CALL ssytrf_rk( 'U', 2, a, 1, e, ip, w, 4, info )
384  CALL chkxer( 'SSYTRF_RK', infot, nout, lerr, ok )
385  infot = 8
386  CALL ssytrf_rk( 'U', 0, a, 1, e, ip, w, 0, info )
387  CALL chkxer( 'SSYTRF_RK', infot, nout, lerr, ok )
388  infot = 8
389  CALL ssytrf_rk( 'U', 0, a, 1, e, ip, w, -2, info )
390  CALL chkxer( 'SSYTRF_RK', infot, nout, lerr, ok )
391 *
392 * SSYTF2_RK
393 *
394  srnamt = 'SSYTF2_RK'
395  infot = 1
396  CALL ssytf2_rk( '/', 0, a, 1, e, ip, info )
397  CALL chkxer( 'SSYTF2_RK', infot, nout, lerr, ok )
398  infot = 2
399  CALL ssytf2_rk( 'U', -1, a, 1, e, ip, info )
400  CALL chkxer( 'SSYTF2_RK', infot, nout, lerr, ok )
401  infot = 4
402  CALL ssytf2_rk( 'U', 2, a, 1, e, ip, info )
403  CALL chkxer( 'SSYTF2_RK', infot, nout, lerr, ok )
404 *
405 * SSYTRI_3
406 *
407  srnamt = 'SSYTRI_3'
408  infot = 1
409  CALL ssytri_3( '/', 0, a, 1, e, ip, w, 1, info )
410  CALL chkxer( 'SSYTRI_3', infot, nout, lerr, ok )
411  infot = 2
412  CALL ssytri_3( 'U', -1, a, 1, e, ip, w, 1, info )
413  CALL chkxer( 'SSYTRI_3', infot, nout, lerr, ok )
414  infot = 4
415  CALL ssytri_3( 'U', 2, a, 1, e, ip, w, 1, info )
416  CALL chkxer( 'SSYTRI_3', infot, nout, lerr, ok )
417  infot = 8
418  CALL ssytri_3( 'U', 0, a, 1, e, ip, w, 0, info )
419  CALL chkxer( 'SSYTRI_3', infot, nout, lerr, ok )
420  infot = 8
421  CALL ssytri_3( 'U', 0, a, 1, e, ip, w, -2, info )
422  CALL chkxer( 'SSYTRI_3', infot, nout, lerr, ok )
423 *
424 * SSYTRI_3X
425 *
426  srnamt = 'SSYTRI_3X'
427  infot = 1
428  CALL ssytri_3x( '/', 0, a, 1, e, ip, w, 1, info )
429  CALL chkxer( 'SSYTRI_3X', infot, nout, lerr, ok )
430  infot = 2
431  CALL ssytri_3x( 'U', -1, a, 1, e, ip, w, 1, info )
432  CALL chkxer( 'SSYTRI_3X', infot, nout, lerr, ok )
433  infot = 4
434  CALL ssytri_3x( 'U', 2, a, 1, e, ip, w, 1, info )
435  CALL chkxer( 'SSYTRI_3X', infot, nout, lerr, ok )
436 *
437 * SSYTRS_3
438 *
439  srnamt = 'SSYTRS_3'
440  infot = 1
441  CALL ssytrs_3( '/', 0, 0, a, 1, e, ip, b, 1, info )
442  CALL chkxer( 'SSYTRS_3', infot, nout, lerr, ok )
443  infot = 2
444  CALL ssytrs_3( 'U', -1, 0, a, 1, e, ip, b, 1, info )
445  CALL chkxer( 'SSYTRS_3', infot, nout, lerr, ok )
446  infot = 3
447  CALL ssytrs_3( 'U', 0, -1, a, 1, e, ip, b, 1, info )
448  CALL chkxer( 'SSYTRS_3', infot, nout, lerr, ok )
449  infot = 5
450  CALL ssytrs_3( 'U', 2, 1, a, 1, e, ip, b, 2, info )
451  CALL chkxer( 'SSYTRS_3', infot, nout, lerr, ok )
452  infot = 9
453  CALL ssytrs_3( 'U', 2, 1, a, 2, e, ip, b, 1, info )
454  CALL chkxer( 'SSYTRS_3', infot, nout, lerr, ok )
455 *
456 * SSYCON_3
457 *
458  srnamt = 'SSYCON_3'
459  infot = 1
460  CALL ssycon_3( '/', 0, a, 1, e, ip, anrm, rcond, w, iw,
461  $ info )
462  CALL chkxer( 'SSYCON_3', infot, nout, lerr, ok )
463  infot = 2
464  CALL ssycon_3( 'U', -1, a, 1, e, ip, anrm, rcond, w, iw,
465  $ info )
466  CALL chkxer( 'SSYCON_3', infot, nout, lerr, ok )
467  infot = 4
468  CALL ssycon_3( 'U', 2, a, 1, e, ip, anrm, rcond, w, iw,
469  $ info )
470  CALL chkxer( 'SSYCON_3', infot, nout, lerr, ok )
471  infot = 7
472  CALL ssycon_3( 'U', 1, a, 1, e, ip, -1.0e0, rcond, w, iw,
473  $ info)
474  CALL chkxer( 'SSYCON_3', infot, nout, lerr, ok )
475 *
476  ELSE IF( lsamen( 2, c2, 'SA' ) ) THEN
477 *
478 * Test error exits of the routines that use factorization
479 * of a symmetric indefinite matrix with Aasen's algorithm.
480 *
481 * SSYTRF_AA
482 *
483  srnamt = 'SSYTRF_AA'
484  infot = 1
485  CALL ssytrf_aa( '/', 0, a, 1, ip, w, 1, info )
486  CALL chkxer( 'SSYTRF_AA', infot, nout, lerr, ok )
487  infot = 2
488  CALL ssytrf_aa( 'U', -1, a, 1, ip, w, 1, info )
489  CALL chkxer( 'SSYTRF_AA', infot, nout, lerr, ok )
490  infot = 4
491  CALL ssytrf_aa( 'U', 2, a, 1, ip, w, 4, info )
492  CALL chkxer( 'SSYTRF_AA', infot, nout, lerr, ok )
493  infot = 7
494  CALL ssytrf_aa( 'U', 0, a, 1, ip, w, 0, info )
495  CALL chkxer( 'SSYTRF_AA', infot, nout, lerr, ok )
496  infot = 7
497  CALL ssytrf_aa( 'U', 0, a, 1, ip, w, -2, info )
498  CALL chkxer( 'SSYTRF_AA', infot, nout, lerr, ok )
499 *
500 * SSYTRS_AA
501 *
502  srnamt = 'SSYTRS_AA'
503  infot = 1
504  CALL ssytrs_aa( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
505  CALL chkxer( 'SSYTRS_AA', infot, nout, lerr, ok )
506  infot = 2
507  CALL ssytrs_aa( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
508  CALL chkxer( 'SSYTRS_AA', infot, nout, lerr, ok )
509  infot = 3
510  CALL ssytrs_aa( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
511  CALL chkxer( 'SSYTRS_AA', infot, nout, lerr, ok )
512  infot = 5
513  CALL ssytrs_aa( 'U', 2, 1, a, 1, ip, b, 2, w, 1, info )
514  CALL chkxer( 'SSYTRS_AA', infot, nout, lerr, ok )
515  infot = 8
516  CALL ssytrs_aa( 'U', 2, 1, a, 2, ip, b, 1, w, 1, info )
517  CALL chkxer( 'SSYTRS_AA', infot, nout, lerr, ok )
518  infot = 10
519  CALL ssytrs_aa( 'U', 0, 1, a, 2, ip, b, 1, w, 0, info )
520  CALL chkxer( 'SSYTRS_AA', infot, nout, lerr, ok )
521  infot = 10
522  CALL ssytrs_aa( 'U', 0, 1, a, 2, ip, b, 1, w, -2, info )
523  CALL chkxer( 'SSYTRS_AA', infot, nout, lerr, ok )
524  ELSE IF( lsamen( 2, c2, 'S2' ) ) THEN
525 *
526 * Test error exits of the routines that use factorization
527 * of a symmetric indefinite matrix with Aasen's algorithm.
528 *
529 * SSYTRF_AA_2STAGE
530 *
531  srnamt = 'SSYTRF_AA_2STAGE'
532  infot = 1
533  CALL ssytrf_aa_2stage( '/', 0, a, 1, a, 1, ip, ip, w, 1,
534  $ info )
535  CALL chkxer( 'SSYTRF_AA_2STAGE', infot, nout, lerr, ok )
536  infot = 2
537  CALL ssytrf_aa_2stage( 'U', -1, a, 1, a, 1, ip, ip, w, 1,
538  $ info )
539  CALL chkxer( 'SSYTRF_AA_2STAGE', infot, nout, lerr, ok )
540  infot = 4
541  CALL ssytrf_aa_2stage( 'U', 2, a, 1, a, 2, ip, ip, w, 1,
542  $ info )
543  CALL chkxer( 'SSYTRF_AA_2STAGE', infot, nout, lerr, ok )
544  infot = 6
545  CALL ssytrf_aa_2stage( 'U', 2, a, 2, a, 1, ip, ip, w, 1,
546  $ info )
547  CALL chkxer( 'SSYTRF_AA_2STAGE', infot, nout, lerr, ok )
548  infot = 10
549  CALL ssytrf_aa_2stage( 'U', 2, a, 2, a, 8, ip, ip, w, 0,
550  $ info )
551  CALL chkxer( 'SSYTRF_AA_2STAGE', infot, nout, lerr, ok )
552 *
553 * SSYTRS_AA_2STAGE
554 *
555  srnamt = 'SSYTRS_AA_2STAGE'
556  infot = 1
557  CALL ssytrs_aa_2stage( '/', 0, 0, a, 1, a, 1, ip, ip,
558  $ b, 1, info )
559  CALL chkxer( 'SSYTRS_AA_2STAGE', infot, nout, lerr, ok )
560  infot = 2
561  CALL ssytrs_aa_2stage( 'U', -1, 0, a, 1, a, 1, ip, ip,
562  $ b, 1, info )
563  CALL chkxer( 'SSYTRS_AA_2STAGE', infot, nout, lerr, ok )
564  infot = 3
565  CALL ssytrs_aa_2stage( 'U', 0, -1, a, 1, a, 1, ip, ip,
566  $ b, 1, info )
567  CALL chkxer( 'SSYTRS_AA_2STAGE', infot, nout, lerr, ok )
568  infot = 5
569  CALL ssytrs_aa_2stage( 'U', 2, 1, a, 1, a, 1, ip, ip,
570  $ b, 1, info )
571  CALL chkxer( 'SSYTRS_AA_2STAGE', infot, nout, lerr, ok )
572  infot = 7
573  CALL ssytrs_aa_2stage( 'U', 2, 1, a, 2, a, 1, ip, ip,
574  $ b, 1, info )
575  CALL chkxer( 'SSYTRS_AA_2STAGE', infot, nout, lerr, ok )
576  infot = 11
577  CALL ssytrs_aa_2stage( 'U', 2, 1, a, 2, a, 8, ip, ip,
578  $ b, 1, info )
579  CALL chkxer( 'SSYTRS_AA_STAGE', infot, nout, lerr, ok )
580 *
581  ELSE IF( lsamen( 2, c2, 'SP' ) ) THEN
582 *
583 * Test error exits of the routines that use factorization
584 * of a symmetric indefinite packed matrix with patrial
585 * (Bunch-Kaufman) pivoting.
586 *
587 * SSPTRF
588 *
589  srnamt = 'SSPTRF'
590  infot = 1
591  CALL ssptrf( '/', 0, a, ip, info )
592  CALL chkxer( 'SSPTRF', infot, nout, lerr, ok )
593  infot = 2
594  CALL ssptrf( 'U', -1, a, ip, info )
595  CALL chkxer( 'SSPTRF', infot, nout, lerr, ok )
596 *
597 * SSPTRI
598 *
599  srnamt = 'SSPTRI'
600  infot = 1
601  CALL ssptri( '/', 0, a, ip, w, info )
602  CALL chkxer( 'SSPTRI', infot, nout, lerr, ok )
603  infot = 2
604  CALL ssptri( 'U', -1, a, ip, w, info )
605  CALL chkxer( 'SSPTRI', infot, nout, lerr, ok )
606 *
607 * SSPTRS
608 *
609  srnamt = 'SSPTRS'
610  infot = 1
611  CALL ssptrs( '/', 0, 0, a, ip, b, 1, info )
612  CALL chkxer( 'SSPTRS', infot, nout, lerr, ok )
613  infot = 2
614  CALL ssptrs( 'U', -1, 0, a, ip, b, 1, info )
615  CALL chkxer( 'SSPTRS', infot, nout, lerr, ok )
616  infot = 3
617  CALL ssptrs( 'U', 0, -1, a, ip, b, 1, info )
618  CALL chkxer( 'SSPTRS', infot, nout, lerr, ok )
619  infot = 7
620  CALL ssptrs( 'U', 2, 1, a, ip, b, 1, info )
621  CALL chkxer( 'SSPTRS', infot, nout, lerr, ok )
622 *
623 * SSPRFS
624 *
625  srnamt = 'SSPRFS'
626  infot = 1
627  CALL ssprfs( '/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
628  $ info )
629  CALL chkxer( 'SSPRFS', infot, nout, lerr, ok )
630  infot = 2
631  CALL ssprfs( 'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
632  $ info )
633  CALL chkxer( 'SSPRFS', infot, nout, lerr, ok )
634  infot = 3
635  CALL ssprfs( 'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
636  $ info )
637  CALL chkxer( 'SSPRFS', infot, nout, lerr, ok )
638  infot = 8
639  CALL ssprfs( 'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, iw,
640  $ info )
641  CALL chkxer( 'SSPRFS', infot, nout, lerr, ok )
642  infot = 10
643  CALL ssprfs( 'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, iw,
644  $ info )
645  CALL chkxer( 'SSPRFS', infot, nout, lerr, ok )
646 *
647 * SSPCON
648 *
649  srnamt = 'SSPCON'
650  infot = 1
651  CALL sspcon( '/', 0, a, ip, anrm, rcond, w, iw, info )
652  CALL chkxer( 'SSPCON', infot, nout, lerr, ok )
653  infot = 2
654  CALL sspcon( 'U', -1, a, ip, anrm, rcond, w, iw, info )
655  CALL chkxer( 'SSPCON', infot, nout, lerr, ok )
656  infot = 5
657  CALL sspcon( 'U', 1, a, ip, -1.0, rcond, w, iw, info )
658  CALL chkxer( 'SSPCON', infot, nout, lerr, ok )
659  END IF
660 *
661 * Print a summary line.
662 *
663  CALL alaesm( path, ok, nout )
664 *
665  RETURN
666 *
667 * End of SERRSY
668 *
669  END
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
subroutine ssptrf(UPLO, N, AP, IPIV, INFO)
SSPTRF
Definition: ssptrf.f:157
subroutine sspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSPCON
Definition: sspcon.f:125
subroutine ssptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
SSPTRS
Definition: ssptrs.f:115
subroutine ssptri(UPLO, N, AP, IPIV, WORK, INFO)
SSPTRI
Definition: ssptri.f:109
subroutine ssprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SSPRFS
Definition: ssprfs.f:179
subroutine ssytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRF
Definition: ssytrf.f:182
subroutine ssytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
SSYTRI_ROOK
Definition: ssytri_rook.f:129
subroutine ssytri2x(UPLO, N, A, LDA, IPIV, WORK, NB, INFO)
SSYTRI2X
Definition: ssytri2x.f:120
subroutine ssytf2_rook(UPLO, N, A, LDA, IPIV, INFO)
SSYTF2_ROOK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-...
Definition: ssytf2_rook.f:194
subroutine ssytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRF_ROOK
Definition: ssytrf_rook.f:208
subroutine ssyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SSYRFS
Definition: ssyrfs.f:191
subroutine ssytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRI2
Definition: ssytri2.f:127
subroutine ssytf2(UPLO, N, A, LDA, IPIV, INFO)
SSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
Definition: ssytf2.f:195
subroutine ssytrs_aa_2stage(UPLO, N, NRHS, A, LDA, TB, LTB, IPIV, IPIV2, B, LDB, INFO)
SSYTRS_AA_2STAGE
subroutine ssycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSYCON_ROOK
Definition: ssycon_rook.f:144
subroutine ssytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRF_AA
Definition: ssytrf_aa.f:132
subroutine ssytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS_ROOK
Definition: ssytrs_rook.f:136
subroutine ssycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSYCON
Definition: ssycon.f:130
subroutine ssytrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
SSYTRS_AA
Definition: ssytrs_aa.f:131
subroutine ssytrf_aa_2stage(UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, WORK, LWORK, INFO)
SSYTRF_AA_2STAGE
subroutine ssytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS
Definition: ssytrs.f:120
subroutine ssytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
SSYTRI
Definition: ssytri.f:114
subroutine serrsy(PATH, NUNIT)
SERRSY
Definition: serrsy.f:55
subroutine ssycon_3(UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSYCON_3
Definition: ssycon_3.f:171
subroutine ssytf2_rk(UPLO, N, A, LDA, E, IPIV, INFO)
SSYTF2_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Ka...
Definition: ssytf2_rk.f:241
subroutine ssytrf_rk(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
SSYTRF_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Ka...
Definition: ssytrf_rk.f:259
subroutine ssytri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
SSYTRI_3
Definition: ssytri_3.f:170
subroutine ssytri_3x(UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO)
SSYTRI_3X
Definition: ssytri_3x.f:159
subroutine ssytrs_3(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO)
SSYTRS_3
Definition: ssytrs_3.f:165