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