LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
serrsyx.f
Go to the documentation of this file.
1 *> \brief \b SERRSYX
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 *>
27 *> Note that this file is used only when the XBLAS are available,
28 *> otherwise serrsy.f defines this subroutine.
29 *> \endverbatim
30 *
31 * Arguments:
32 * ==========
33 *
34 *> \param[in] PATH
35 *> \verbatim
36 *> PATH is CHARACTER*3
37 *> The LAPACK path name for the routines to be tested.
38 *> \endverbatim
39 *>
40 *> \param[in] NUNIT
41 *> \verbatim
42 *> NUNIT is INTEGER
43 *> The unit number for output.
44 *> \endverbatim
45 *
46 * Authors:
47 * ========
48 *
49 *> \author Univ. of Tennessee
50 *> \author Univ. of California Berkeley
51 *> \author Univ. of Colorado Denver
52 *> \author NAG Ltd.
53 *
54 *> \ingroup single_lin
55 *
56 * =====================================================================
57  SUBROUTINE serrsy( PATH, NUNIT )
58 *
59 * -- LAPACK test routine --
60 * -- LAPACK is a software package provided by Univ. of Tennessee, --
61 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
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 EQ
76  CHARACTER*2 C2
77  INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
78  REAL ANRM, RCOND, BERR
79 * ..
80 * .. Local Arrays ..
81  INTEGER IP( NMAX ), IW( NMAX )
82  REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
83  $ E( NMAX ), R1( NMAX ), R2( NMAX ), W( 3*NMAX ),
84  $ X( NMAX ), S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
85  $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
86 * ..
87 * .. External Functions ..
88  LOGICAL LSAMEN
89  EXTERNAL lsamen
90 * ..
91 * .. External Subroutines ..
92  EXTERNAL alaesm, chkxer, sspcon, ssprfs, ssptrf, ssptri,
98 * ..
99 * .. Scalars in Common ..
100  LOGICAL LERR, OK
101  CHARACTER*32 SRNAMT
102  INTEGER INFOT, NOUT
103 * ..
104 * .. Common blocks ..
105  COMMON / infoc / infot, nout, ok, lerr
106  COMMON / srnamc / srnamt
107 * ..
108 * .. Intrinsic Functions ..
109  INTRINSIC real
110 * ..
111 * .. Executable Statements ..
112 *
113  nout = nunit
114  WRITE( nout, fmt = * )
115  c2 = path( 2: 3 )
116 *
117 * Set the variables to innocuous values.
118 *
119  DO 20 j = 1, nmax
120  DO 10 i = 1, nmax
121  a( i, j ) = 1. / real( i+j )
122  af( i, j ) = 1. / real( i+j )
123  10 CONTINUE
124  b( j ) = 0.e+0
125  e( j ) = 0.e+0
126  r1( j ) = 0.e+0
127  r2( j ) = 0.e+0
128  w( j ) = 0.e+0
129  x( j ) = 0.e+0
130  ip( j ) = j
131  iw( j ) = j
132  20 CONTINUE
133  anrm = 1.0
134  rcond = 1.0
135  ok = .true.
136 *
137  IF( lsamen( 2, c2, 'SY' ) ) THEN
138 *
139 * Test error exits of the routines that use factorization
140 * of a symmetric indefinite matrix with patrial
141 * (Bunch-Kaufman) pivoting.
142 *
143 * SSYTRF
144 *
145  srnamt = 'SSYTRF'
146  infot = 1
147  CALL ssytrf( '/', 0, a, 1, ip, w, 1, info )
148  CALL chkxer( 'SSYTRF', infot, nout, lerr, ok )
149  infot = 2
150  CALL ssytrf( 'U', -1, a, 1, ip, w, 1, info )
151  CALL chkxer( 'SSYTRF', infot, nout, lerr, ok )
152  infot = 4
153  CALL ssytrf( 'U', 2, a, 1, ip, w, 4, info )
154  CALL chkxer( 'SSYTRF', infot, nout, lerr, ok )
155  infot = 7
156  CALL ssytrf( 'U', 0, a, 1, ip, w, 0, info )
157  CALL chkxer( 'SSYTRF', infot, nout, lerr, ok )
158  infot = 7
159  CALL ssytrf( 'U', 0, a, 1, ip, w, -2, info )
160  CALL chkxer( 'SSYTRF', infot, nout, lerr, ok )
161 *
162 * SSYTF2
163 *
164  srnamt = 'SSYTF2'
165  infot = 1
166  CALL ssytf2( '/', 0, a, 1, ip, info )
167  CALL chkxer( 'SSYTF2', infot, nout, lerr, ok )
168  infot = 2
169  CALL ssytf2( 'U', -1, a, 1, ip, info )
170  CALL chkxer( 'SSYTF2', infot, nout, lerr, ok )
171  infot = 4
172  CALL ssytf2( 'U', 2, a, 1, ip, info )
173  CALL chkxer( 'SSYTF2', infot, nout, lerr, ok )
174 *
175 * SSYTRI
176 *
177  srnamt = 'SSYTRI'
178  infot = 1
179  CALL ssytri( '/', 0, a, 1, ip, w, info )
180  CALL chkxer( 'SSYTRI', infot, nout, lerr, ok )
181  infot = 2
182  CALL ssytri( 'U', -1, a, 1, ip, w, info )
183  CALL chkxer( 'SSYTRI', infot, nout, lerr, ok )
184  infot = 4
185  CALL ssytri( 'U', 2, a, 1, ip, w, info )
186  CALL chkxer( 'SSYTRI', infot, nout, lerr, ok )
187 *
188 * SSYTRI2
189 *
190  srnamt = 'SSYTRI2'
191  infot = 1
192  CALL ssytri2( '/', 0, a, 1, ip, w, iw, info )
193  CALL chkxer( 'SSYTRI', infot, nout, lerr, ok )
194  infot = 2
195  CALL ssytri2( 'U', -1, a, 1, ip, w, iw, info )
196  CALL chkxer( 'SSYTRI', infot, nout, lerr, ok )
197  infot = 4
198  CALL ssytri2( 'U', 2, a, 1, ip, w, iw, info )
199  CALL chkxer( 'SSYTRI', infot, nout, lerr, ok )
200 *
201 * SSYTRI2X
202 *
203  srnamt = 'SSYTRI2X'
204  infot = 1
205  CALL ssytri2x( '/', 0, a, 1, ip, w, 1, info )
206  CALL chkxer( 'SSYTRI2X', infot, nout, lerr, ok )
207  infot = 2
208  CALL ssytri2x( 'U', -1, a, 1, ip, w, 1, info )
209  CALL chkxer( 'SSYTRI2X', infot, nout, lerr, ok )
210  infot = 4
211  CALL ssytri2x( 'U', 2, a, 1, ip, w, 1, info )
212  CALL chkxer( 'SSYTRI2X', infot, nout, lerr, ok )
213 *
214 * SSYTRS
215 *
216  srnamt = 'SSYTRS'
217  infot = 1
218  CALL ssytrs( '/', 0, 0, a, 1, ip, b, 1, info )
219  CALL chkxer( 'SSYTRS', infot, nout, lerr, ok )
220  infot = 2
221  CALL ssytrs( 'U', -1, 0, a, 1, ip, b, 1, info )
222  CALL chkxer( 'SSYTRS', infot, nout, lerr, ok )
223  infot = 3
224  CALL ssytrs( 'U', 0, -1, a, 1, ip, b, 1, info )
225  CALL chkxer( 'SSYTRS', infot, nout, lerr, ok )
226  infot = 5
227  CALL ssytrs( 'U', 2, 1, a, 1, ip, b, 2, info )
228  CALL chkxer( 'SSYTRS', infot, nout, lerr, ok )
229  infot = 8
230  CALL ssytrs( 'U', 2, 1, a, 2, ip, b, 1, info )
231  CALL chkxer( 'SSYTRS', infot, nout, lerr, ok )
232 *
233 * SSYRFS
234 *
235  srnamt = 'SSYRFS'
236  infot = 1
237  CALL ssyrfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
238  $ iw, info )
239  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
240  infot = 2
241  CALL ssyrfs( 'U', -1, 0, 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 = 3
245  CALL ssyrfs( 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
246  $ w, iw, info )
247  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
248  infot = 5
249  CALL ssyrfs( 'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
250  $ iw, info )
251  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
252  infot = 7
253  CALL ssyrfs( 'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
254  $ iw, info )
255  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
256  infot = 10
257  CALL ssyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
258  $ iw, info )
259  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
260  infot = 12
261  CALL ssyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
262  $ iw, info )
263  CALL chkxer( 'SSYRFS', infot, nout, lerr, ok )
264 *
265 * SSYRFSX
266 *
267  n_err_bnds = 3
268  nparams = 0
269  srnamt = 'SSYRFSX'
270  infot = 1
271  CALL ssyrfsx( '/', eq, 0, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
272  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
273  $ params, w, iw, info )
274  CALL chkxer( 'SSYRFSX', infot, nout, lerr, ok )
275  infot = 2
276  CALL ssyrfsx( 'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
277  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
278  $ params, w, iw, info )
279  CALL chkxer( 'SSYRFSX', infot, nout, lerr, ok )
280  eq = 'N'
281  infot = 3
282  CALL ssyrfsx( 'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
283  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
284  $ params, w, iw, info )
285  CALL chkxer( 'SSYRFSX', infot, nout, lerr, ok )
286  infot = 4
287  CALL ssyrfsx( 'U', eq, 0, -1, a, 1, af, 1, ip, s, b, 1, x, 1,
288  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
289  $ params, w, iw, info )
290  CALL chkxer( 'SSYRFSX', infot, nout, lerr, ok )
291  infot = 6
292  CALL ssyrfsx( 'U', eq, 2, 1, a, 1, af, 2, ip, s, b, 2, x, 2,
293  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
294  $ params, w, iw, info )
295  CALL chkxer( 'SSYRFSX', infot, nout, lerr, ok )
296  infot = 8
297  CALL ssyrfsx( 'U', eq, 2, 1, a, 2, af, 1, ip, s, b, 2, x, 2,
298  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
299  $ params, w, iw, info )
300  CALL chkxer( 'SSYRFSX', infot, nout, lerr, ok )
301  infot = 12
302  CALL ssyrfsx( 'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 1, x, 2,
303  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
304  $ params, w, iw, info )
305  CALL chkxer( 'SSYRFSX', infot, nout, lerr, ok )
306  infot = 14
307  CALL ssyrfsx( 'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 2, x, 1,
308  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
309  $ params, w, iw, info )
310  CALL chkxer( 'SSYRFSX', infot, nout, lerr, ok )
311 *
312 * SSYCON
313 *
314  srnamt = 'SSYCON'
315  infot = 1
316  CALL ssycon( '/', 0, a, 1, ip, anrm, rcond, w, iw, info )
317  CALL chkxer( 'SSYCON', infot, nout, lerr, ok )
318  infot = 2
319  CALL ssycon( 'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
320  CALL chkxer( 'SSYCON', infot, nout, lerr, ok )
321  infot = 4
322  CALL ssycon( 'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
323  CALL chkxer( 'SSYCON', infot, nout, lerr, ok )
324  infot = 6
325  CALL ssycon( 'U', 1, a, 1, ip, -1.0, rcond, w, iw, info )
326  CALL chkxer( 'SSYCON', infot, nout, lerr, ok )
327 *
328  ELSE IF( lsamen( 2, c2, 'SR' ) ) THEN
329 *
330 * Test error exits of the routines that use factorization
331 * of a symmetric indefinite matrix with rook
332 * (bounded Bunch-Kaufman) pivoting.
333 *
334 * SSYTRF_ROOK
335 *
336  srnamt = 'SSYTRF_ROOK'
337  infot = 1
338  CALL ssytrf_rook( '/', 0, a, 1, ip, w, 1, info )
339  CALL chkxer( 'SSYTRF_ROOK', infot, nout, lerr, ok )
340  infot = 2
341  CALL ssytrf_rook( 'U', -1, a, 1, ip, w, 1, info )
342  CALL chkxer( 'SSYTRF_ROOK', infot, nout, lerr, ok )
343  infot = 4
344  CALL ssytrf_rook( 'U', 2, a, 1, ip, w, 4, info )
345  CALL chkxer( 'SSYTRF_ROOK', infot, nout, lerr, ok )
346  infot = 7
347  CALL ssytrf_rook( 'U', 0, a, 1, ip, w, 0, info )
348  CALL chkxer( 'SSYTRF_ROOK', infot, nout, lerr, ok )
349  infot = 7
350  CALL ssytrf_rook( 'U', 0, a, 1, ip, w, -2, info )
351  CALL chkxer( 'SSYTRF_ROOK', infot, nout, lerr, ok )
352 *
353 * SSYTF2_ROOK
354 *
355  srnamt = 'SSYTF2_ROOK'
356  infot = 1
357  CALL ssytf2_rook( '/', 0, a, 1, ip, info )
358  CALL chkxer( 'SSYTF2_ROOK', infot, nout, lerr, ok )
359  infot = 2
360  CALL ssytf2_rook( 'U', -1, a, 1, ip, info )
361  CALL chkxer( 'SSYTF2_ROOK', infot, nout, lerr, ok )
362  infot = 4
363  CALL ssytf2_rook( 'U', 2, a, 1, ip, info )
364  CALL chkxer( 'SSYTF2_ROOK', infot, nout, lerr, ok )
365 *
366 * SSYTRI_ROOK
367 *
368  srnamt = 'SSYTRI_ROOK'
369  infot = 1
370  CALL ssytri_rook( '/', 0, a, 1, ip, w, info )
371  CALL chkxer( 'SSYTRI_ROOK', infot, nout, lerr, ok )
372  infot = 2
373  CALL ssytri_rook( 'U', -1, a, 1, ip, w, info )
374  CALL chkxer( 'SSYTRI_ROOK', infot, nout, lerr, ok )
375  infot = 4
376  CALL ssytri_rook( 'U', 2, a, 1, ip, w, info )
377  CALL chkxer( 'SSYTRI_ROOK', infot, nout, lerr, ok )
378 *
379 * SSYTRS_ROOK
380 *
381  srnamt = 'SSYTRS_ROOK'
382  infot = 1
383  CALL ssytrs_rook( '/', 0, 0, a, 1, ip, b, 1, info )
384  CALL chkxer( 'SSYTRS_ROOK', infot, nout, lerr, ok )
385  infot = 2
386  CALL ssytrs_rook( 'U', -1, 0, a, 1, ip, b, 1, info )
387  CALL chkxer( 'SSYTRS_ROOK', infot, nout, lerr, ok )
388  infot = 3
389  CALL ssytrs_rook( 'U', 0, -1, a, 1, ip, b, 1, info )
390  CALL chkxer( 'SSYTRS_ROOK', infot, nout, lerr, ok )
391  infot = 5
392  CALL ssytrs_rook( 'U', 2, 1, a, 1, ip, b, 2, info )
393  CALL chkxer( 'SSYTRS_ROOK', infot, nout, lerr, ok )
394  infot = 8
395  CALL ssytrs_rook( 'U', 2, 1, a, 2, ip, b, 1, info )
396  CALL chkxer( 'SSYTRS_ROOK', infot, nout, lerr, ok )
397 *
398 * SSYCON_ROOK
399 *
400  srnamt = 'SSYCON_ROOK'
401  infot = 1
402  CALL ssycon_rook( '/', 0, a, 1, ip, anrm, rcond, w, iw, info )
403  CALL chkxer( 'SSYCON_ROOK', infot, nout, lerr, ok )
404  infot = 2
405  CALL ssycon_rook( 'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
406  CALL chkxer( 'SSYCON_ROOK', infot, nout, lerr, ok )
407  infot = 4
408  CALL ssycon_rook( 'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
409  CALL chkxer( 'SSYCON_ROOK', infot, nout, lerr, ok )
410  infot = 6
411  CALL ssycon_rook( 'U', 1, a, 1, ip, -1.0, rcond, w, iw, info )
412  CALL chkxer( 'SSYCON_ROOK', infot, nout, lerr, ok )
413 *
414  ELSE IF( lsamen( 2, c2, 'SK' ) ) THEN
415 *
416 * Test error exits of the routines that use factorization
417 * of a symmetric indefinite matrix with rook
418 * (bounded Bunch-Kaufman) pivoting with the new storage
419 * format for factors L ( or U) and D.
420 *
421 * L (or U) is stored in A, diagonal of D is stored on the
422 * diagonal of A, subdiagonal of D is stored in a separate array E.
423 *
424 * SSYTRF_RK
425 *
426  srnamt = 'SSYTRF_RK'
427  infot = 1
428  CALL ssytrf_rk( '/', 0, a, 1, e, ip, w, 1, info )
429  CALL chkxer( 'SSYTRF_RK', infot, nout, lerr, ok )
430  infot = 2
431  CALL ssytrf_rk( 'U', -1, a, 1, e, ip, w, 1, info )
432  CALL chkxer( 'SSYTRF_RK', infot, nout, lerr, ok )
433  infot = 4
434  CALL ssytrf_rk( 'U', 2, a, 1, e, ip, w, 4, info )
435  CALL chkxer( 'SSYTRF_RK', infot, nout, lerr, ok )
436  infot = 8
437  CALL ssytrf_rk( 'U', 0, a, 1, e, ip, w, 0, info )
438  CALL chkxer( 'SSYTRF_RK', infot, nout, lerr, ok )
439  infot = 8
440  CALL ssytrf_rk( 'U', 0, a, 1, e, ip, w, -2, info )
441  CALL chkxer( 'SSYTRF_RK', infot, nout, lerr, ok )
442 *
443 * SSYTF2_RK
444 *
445  srnamt = 'SSYTF2_RK'
446  infot = 1
447  CALL ssytf2_rk( '/', 0, a, 1, e, ip, info )
448  CALL chkxer( 'SSYTF2_RK', infot, nout, lerr, ok )
449  infot = 2
450  CALL ssytf2_rk( 'U', -1, a, 1, e, ip, info )
451  CALL chkxer( 'SSYTF2_RK', infot, nout, lerr, ok )
452  infot = 4
453  CALL ssytf2_rk( 'U', 2, a, 1, e, ip, info )
454  CALL chkxer( 'SSYTF2_RK', infot, nout, lerr, ok )
455 *
456 * SSYTRI_3
457 *
458  srnamt = 'SSYTRI_3'
459  infot = 1
460  CALL ssytri_3( '/', 0, a, 1, e, ip, w, 1, info )
461  CALL chkxer( 'SSYTRI_3', infot, nout, lerr, ok )
462  infot = 2
463  CALL ssytri_3( 'U', -1, a, 1, e, ip, w, 1, info )
464  CALL chkxer( 'SSYTRI_3', infot, nout, lerr, ok )
465  infot = 4
466  CALL ssytri_3( 'U', 2, a, 1, e, ip, w, 1, info )
467  CALL chkxer( 'SSYTRI_3', infot, nout, lerr, ok )
468  infot = 8
469  CALL ssytri_3( 'U', 0, a, 1, e, ip, w, 0, info )
470  CALL chkxer( 'SSYTRI_3', infot, nout, lerr, ok )
471  infot = 8
472  CALL ssytri_3( 'U', 0, a, 1, e, ip, w, -2, info )
473  CALL chkxer( 'SSYTRI_3', infot, nout, lerr, ok )
474 *
475 * SSYTRI_3X
476 *
477  srnamt = 'SSYTRI_3X'
478  infot = 1
479  CALL ssytri_3x( '/', 0, a, 1, e, ip, w, 1, info )
480  CALL chkxer( 'SSYTRI_3X', infot, nout, lerr, ok )
481  infot = 2
482  CALL ssytri_3x( 'U', -1, a, 1, e, ip, w, 1, info )
483  CALL chkxer( 'SSYTRI_3X', infot, nout, lerr, ok )
484  infot = 4
485  CALL ssytri_3x( 'U', 2, a, 1, e, ip, w, 1, info )
486  CALL chkxer( 'SSYTRI_3X', infot, nout, lerr, ok )
487 *
488 * SSYTRS_3
489 *
490  srnamt = 'SSYTRS_3'
491  infot = 1
492  CALL ssytrs_3( '/', 0, 0, a, 1, e, ip, b, 1, info )
493  CALL chkxer( 'SSYTRS_3', infot, nout, lerr, ok )
494  infot = 2
495  CALL ssytrs_3( 'U', -1, 0, a, 1, e, ip, b, 1, info )
496  CALL chkxer( 'SSYTRS_3', infot, nout, lerr, ok )
497  infot = 3
498  CALL ssytrs_3( 'U', 0, -1, a, 1, e, ip, b, 1, info )
499  CALL chkxer( 'SSYTRS_3', infot, nout, lerr, ok )
500  infot = 5
501  CALL ssytrs_3( 'U', 2, 1, a, 1, e, ip, b, 2, info )
502  CALL chkxer( 'SSYTRS_3', infot, nout, lerr, ok )
503  infot = 9
504  CALL ssytrs_3( 'U', 2, 1, a, 2, e, ip, b, 1, info )
505  CALL chkxer( 'SSYTRS_3', infot, nout, lerr, ok )
506 *
507 * SSYCON_3
508 *
509  srnamt = 'SSYCON_3'
510  infot = 1
511  CALL ssycon_3( '/', 0, a, 1, e, ip, anrm, rcond, w, iw,
512  $ info )
513  CALL chkxer( 'SSYCON_3', infot, nout, lerr, ok )
514  infot = 2
515  CALL ssycon_3( 'U', -1, a, 1, e, ip, anrm, rcond, w, iw,
516  $ info )
517  CALL chkxer( 'SSYCON_3', infot, nout, lerr, ok )
518  infot = 4
519  CALL ssycon_3( 'U', 2, a, 1, e, ip, anrm, rcond, w, iw,
520  $ info )
521  CALL chkxer( 'SSYCON_3', infot, nout, lerr, ok )
522  infot = 7
523  CALL ssycon_3( 'U', 1, a, 1, e, ip, -1.0e0, rcond, w, iw,
524  $ info)
525  CALL chkxer( 'SSYCON_3', infot, nout, lerr, ok )
526 *
527  ELSE IF( lsamen( 2, c2, 'SP' ) ) THEN
528 *
529 * Test error exits of the routines that use factorization
530 * of a symmetric indefinite packed matrix with patrial
531 * (Bunch-Kaufman) pivoting.
532 *
533 * SSPTRF
534 *
535  srnamt = 'SSPTRF'
536  infot = 1
537  CALL ssptrf( '/', 0, a, ip, info )
538  CALL chkxer( 'SSPTRF', infot, nout, lerr, ok )
539  infot = 2
540  CALL ssptrf( 'U', -1, a, ip, info )
541  CALL chkxer( 'SSPTRF', infot, nout, lerr, ok )
542 *
543 * SSPTRI
544 *
545  srnamt = 'SSPTRI'
546  infot = 1
547  CALL ssptri( '/', 0, a, ip, w, info )
548  CALL chkxer( 'SSPTRI', infot, nout, lerr, ok )
549  infot = 2
550  CALL ssptri( 'U', -1, a, ip, w, info )
551  CALL chkxer( 'SSPTRI', infot, nout, lerr, ok )
552 *
553 * SSPTRS
554 *
555  srnamt = 'SSPTRS'
556  infot = 1
557  CALL ssptrs( '/', 0, 0, a, ip, b, 1, info )
558  CALL chkxer( 'SSPTRS', infot, nout, lerr, ok )
559  infot = 2
560  CALL ssptrs( 'U', -1, 0, a, ip, b, 1, info )
561  CALL chkxer( 'SSPTRS', infot, nout, lerr, ok )
562  infot = 3
563  CALL ssptrs( 'U', 0, -1, a, ip, b, 1, info )
564  CALL chkxer( 'SSPTRS', infot, nout, lerr, ok )
565  infot = 7
566  CALL ssptrs( 'U', 2, 1, a, ip, b, 1, info )
567  CALL chkxer( 'SSPTRS', infot, nout, lerr, ok )
568 *
569 * SSPRFS
570 *
571  srnamt = 'SSPRFS'
572  infot = 1
573  CALL ssprfs( '/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
574  $ info )
575  CALL chkxer( 'SSPRFS', infot, nout, lerr, ok )
576  infot = 2
577  CALL ssprfs( 'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
578  $ info )
579  CALL chkxer( 'SSPRFS', infot, nout, lerr, ok )
580  infot = 3
581  CALL ssprfs( 'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
582  $ info )
583  CALL chkxer( 'SSPRFS', infot, nout, lerr, ok )
584  infot = 8
585  CALL ssprfs( 'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, iw,
586  $ info )
587  CALL chkxer( 'SSPRFS', infot, nout, lerr, ok )
588  infot = 10
589  CALL ssprfs( 'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, iw,
590  $ info )
591  CALL chkxer( 'SSPRFS', infot, nout, lerr, ok )
592 *
593 * SSPCON
594 *
595  srnamt = 'SSPCON'
596  infot = 1
597  CALL sspcon( '/', 0, a, ip, anrm, rcond, w, iw, info )
598  CALL chkxer( 'SSPCON', infot, nout, lerr, ok )
599  infot = 2
600  CALL sspcon( 'U', -1, a, ip, anrm, rcond, w, iw, info )
601  CALL chkxer( 'SSPCON', infot, nout, lerr, ok )
602  infot = 5
603  CALL sspcon( 'U', 1, a, ip, -1.0, rcond, w, iw, info )
604  CALL chkxer( 'SSPCON', infot, nout, lerr, ok )
605  END IF
606 *
607 * Print a summary line.
608 *
609  CALL alaesm( path, ok, nout )
610 *
611  RETURN
612 *
613 * End of SERRSYX
614 *
615  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 ssyrfsx(UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO)
SSYRFSX
Definition: ssyrfsx.f:402
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 ssycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSYCON_ROOK
Definition: ssycon_rook.f:144
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(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