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