OpenRadioss 2025.1.11
OpenRadioss project
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,
88 $ ssptrs, ssycon, ssycon_3, ssycon_rook, ssyrfs,
89 $ ssytf2_rk, ssytf2_rook, ssytrf, ssytrf_rk,
90 $ ssytrf_rook, ssytri, ssytf2, ssytri_3,
91 $ ssytri_3x, ssytri_rook, ssytrf_aa, ssytri2,
92 $ ssytri2x, ssytrs, ssytrs_3, ssytrs_rook,
93 $ ssytrs_aa, ssytrf_aa_2stage, ssytrs_aa_2stage
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
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
ssptrf
subroutine ssptrf(uplo, n, ap, ipiv, info)
SSPTRF
Definition ssptrf.f:157
ssprfs
subroutine ssprfs(uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
SSPRFS
Definition ssprfs.f:179
sspcon
subroutine sspcon(uplo, n, ap, ipiv, anorm, rcond, work, iwork, info)
SSPCON
Definition sspcon.f:125
ssptri
subroutine ssptri(uplo, n, ap, ipiv, work, info)
SSPTRI
Definition ssptri.f:109
ssptrs
subroutine ssptrs(uplo, n, nrhs, ap, ipiv, b, ldb, info)
SSPTRS
Definition ssptrs.f:115
ssycon_rook
subroutine ssycon_rook(uplo, n, a, lda, ipiv, anorm, rcond, work, iwork, info)
SSYCON_ROOK
Definition ssycon_rook.f:144
ssytrs_aa
subroutine ssytrs_aa(uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork, info)
SSYTRS_AA
Definition ssytrs_aa.f:131
ssycon
subroutine ssycon(uplo, n, a, lda, ipiv, anorm, rcond, work, iwork, info)
SSYCON
Definition ssycon.f:130
ssytrf_rook
subroutine ssytrf_rook(uplo, n, a, lda, ipiv, work, lwork, info)
SSYTRF_ROOK
Definition ssytrf_rook.f:208
ssytri
subroutine ssytri(uplo, n, a, lda, ipiv, work, info)
SSYTRI
Definition ssytri.f:114
ssytri2x
subroutine ssytri2x(uplo, n, a, lda, ipiv, work, nb, info)
SSYTRI2X
Definition ssytri2x.f:120
ssytf2_rook
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
ssyrfs
subroutine ssyrfs(uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
SSYRFS
Definition ssyrfs.f:191
ssytrf_aa
subroutine ssytrf_aa(uplo, n, a, lda, ipiv, work, lwork, info)
SSYTRF_AA
Definition ssytrf_aa.f:132
ssytrf_aa_2stage
subroutine ssytrf_aa_2stage(uplo, n, a, lda, tb, ltb, ipiv, ipiv2, work, lwork, info)
SSYTRF_AA_2STAGE
Definition ssytrf_aa_2stage.f:160
ssytri2
subroutine ssytri2(uplo, n, a, lda, ipiv, work, lwork, info)
SSYTRI2
Definition ssytri2.f:127
ssytrs_rook
subroutine ssytrs_rook(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
SSYTRS_ROOK
Definition ssytrs_rook.f:136
ssytrf
subroutine ssytrf(uplo, n, a, lda, ipiv, work, lwork, info)
SSYTRF
Definition ssytrf.f:182
ssytrs_aa_2stage
subroutine ssytrs_aa_2stage(uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, info)
SSYTRS_AA_2STAGE
Definition ssytrs_aa_2stage.f:139
ssytf2
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
ssytri_rook
subroutine ssytri_rook(uplo, n, a, lda, ipiv, work, info)
SSYTRI_ROOK
Definition ssytri_rook.f:129
ssytrs
subroutine ssytrs(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
SSYTRS
Definition ssytrs.f:120
serrsy
subroutine serrsy(path, nunit)
SERRSY
Definition serrsy.f:55
ssycon_3
subroutine ssycon_3(uplo, n, a, lda, e, ipiv, anorm, rcond, work, iwork, info)
SSYCON_3
Definition ssycon_3.f:171
ssytf2_rk
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
ssytrf_rk
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
ssytri_3
subroutine ssytri_3(uplo, n, a, lda, e, ipiv, work, lwork, info)
SSYTRI_3
Definition ssytri_3.f:170
ssytri_3x
subroutine ssytri_3x(uplo, n, a, lda, e, ipiv, work, nb, info)
SSYTRI_3X
Definition ssytri_3x.f:159
ssytrs_3
subroutine ssytrs_3(uplo, n, nrhs, a, lda, e, ipiv, b, ldb, info)
SSYTRS_3
Definition ssytrs_3.f:165