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