LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
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 partial
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 partial
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 alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
subroutine ssycon_3(uplo, n, a, lda, e, ipiv, anorm, rcond, work, iwork, info)
SSYCON_3
Definition ssycon_3.f:171
subroutine ssycon_rook(uplo, n, a, lda, ipiv, anorm, rcond, work, iwork, info)
SSYCON_ROOK
subroutine ssycon(uplo, n, a, lda, ipiv, anorm, rcond, work, iwork, info)
SSYCON
Definition ssycon.f:130
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 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 ssytf2_rook(uplo, n, a, lda, ipiv, info)
SSYTF2_ROOK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-...
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 ssytrf_aa_2stage(uplo, n, a, lda, tb, ltb, ipiv, ipiv2, work, lwork, info)
SSYTRF_AA_2STAGE
subroutine ssytrf_aa(uplo, n, a, lda, ipiv, work, lwork, info)
SSYTRF_AA
Definition ssytrf_aa.f:132
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 ssytrf_rook(uplo, n, a, lda, ipiv, work, lwork, info)
SSYTRF_ROOK
subroutine ssytrf(uplo, n, a, lda, ipiv, work, lwork, info)
SSYTRF
Definition ssytrf.f:182
subroutine ssytri2(uplo, n, a, lda, ipiv, work, lwork, info)
SSYTRI2
Definition ssytri2.f:127
subroutine ssytri2x(uplo, n, a, lda, ipiv, work, nb, info)
SSYTRI2X
Definition ssytri2x.f:120
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 ssytri_rook(uplo, n, a, lda, ipiv, work, info)
SSYTRI_ROOK
subroutine ssytri(uplo, n, a, lda, ipiv, work, info)
SSYTRI
Definition ssytri.f:114
subroutine ssytrs_3(uplo, n, nrhs, a, lda, e, ipiv, b, ldb, info)
SSYTRS_3
Definition ssytrs_3.f:165
subroutine ssytrs_aa_2stage(uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, info)
SSYTRS_AA_2STAGE
subroutine ssytrs_aa(uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork, info)
SSYTRS_AA
Definition ssytrs_aa.f:131
subroutine ssytrs_rook(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
SSYTRS_ROOK
subroutine ssytrs(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
SSYTRS
Definition ssytrs.f:120
subroutine sspcon(uplo, n, ap, ipiv, anorm, rcond, work, iwork, info)
SSPCON
Definition sspcon.f:125
subroutine ssprfs(uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
SSPRFS
Definition ssprfs.f:179
subroutine ssptrf(uplo, n, ap, ipiv, info)
SSPTRF
Definition ssptrf.f:157
subroutine ssptri(uplo, n, ap, ipiv, work, info)
SSPTRI
Definition ssptri.f:109
subroutine ssptrs(uplo, n, nrhs, ap, ipiv, b, ldb, info)
SSPTRS
Definition ssptrs.f:115
subroutine serrsy(path, nunit)
SERRSY
Definition serrsy.f:55