1 SUBROUTINE SERRSY( PATH, NUNIT )
2 *
3 * -- LAPACK test routine (version 3.2) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * SERRSY tests the error exits for the REAL routines
16 * for symmetric indefinite matrices.
17 *
18 * Note that this file is used only when the XBLAS are available,
19 * otherwise serrsy.f defines this subroutine.
20 *
21 * Arguments
22 * =========
23 *
24 * PATH (input) CHARACTER*3
25 * The LAPACK path name for the routines to be tested.
26 *
27 * NUNIT (input) INTEGER
28 * The unit number for output.
29 *
30 * =====================================================================
31 *
32 * .. Parameters ..
33 INTEGER NMAX
34 PARAMETER ( NMAX = 4 )
35 * ..
36 * .. Local Scalars ..
37 CHARACTER EQ
38 CHARACTER*2 C2
39 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
40 REAL ANRM, RCOND, BERR
41 * ..
42 * .. Local Arrays ..
43 INTEGER IP( NMAX ), IW( NMAX )
44 REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
45 $ R1( NMAX ), R2( NMAX ), W( 3*NMAX ), X( NMAX ),
46 $ S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
47 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
48 * ..
49 * .. External Functions ..
50 LOGICAL LSAMEN
51 EXTERNAL LSAMEN
52 * ..
53 * .. External Subroutines ..
54 EXTERNAL ALAESM, CHKXER, SSPCON, SSPRFS, SSPTRF, SSPTRI,
55 $ SSPTRS, SSYCON, SSYRFS, SSYTF2, SSYTRF, SSYTRI,
56 $ SSYTRI2, SSYTRS, SSYRFSX
57 * ..
58 * .. Scalars in Common ..
59 LOGICAL LERR, OK
60 CHARACTER*32 SRNAMT
61 INTEGER INFOT, NOUT
62 * ..
63 * .. Common blocks ..
64 COMMON / INFOC / INFOT, NOUT, OK, LERR
65 COMMON / SRNAMC / SRNAMT
66 * ..
67 * .. Intrinsic Functions ..
68 INTRINSIC REAL
69 * ..
70 * .. Executable Statements ..
71 *
72 NOUT = NUNIT
73 WRITE( NOUT, FMT = * )
74 C2 = PATH( 2: 3 )
75 *
76 * Set the variables to innocuous values.
77 *
78 DO 20 J = 1, NMAX
79 DO 10 I = 1, NMAX
80 A( I, J ) = 1. / REAL( I+J )
81 AF( I, J ) = 1. / REAL( I+J )
82 10 CONTINUE
83 B( J ) = 0.
84 R1( J ) = 0.
85 R2( J ) = 0.
86 W( J ) = 0.
87 X( J ) = 0.
88 S( J ) = 0.
89 IP( J ) = J
90 IW( J ) = J
91 20 CONTINUE
92 ANRM = 1.0
93 RCOND = 1.0
94 OK = .TRUE.
95 *
96 IF( LSAMEN( 2, C2, 'SY' ) ) THEN
97 *
98 * Test error exits of the routines that use the Bunch-Kaufman
99 * factorization of a symmetric indefinite matrix.
100 *
101 * SSYTRF
102 *
103 SRNAMT = 'SSYTRF'
104 INFOT = 1
105 CALL SSYTRF( '/', 0, A, 1, IP, W, 1, INFO )
106 CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
107 INFOT = 2
108 CALL SSYTRF( 'U', -1, A, 1, IP, W, 1, INFO )
109 CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
110 INFOT = 4
111 CALL SSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
112 CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
113 *
114 * SSYTF2
115 *
116 SRNAMT = 'SSYTF2'
117 INFOT = 1
118 CALL SSYTF2( '/', 0, A, 1, IP, INFO )
119 CALL CHKXER( 'SSYTF2', INFOT, NOUT, LERR, OK )
120 INFOT = 2
121 CALL SSYTF2( 'U', -1, A, 1, IP, INFO )
122 CALL CHKXER( 'SSYTF2', INFOT, NOUT, LERR, OK )
123 INFOT = 4
124 CALL SSYTF2( 'U', 2, A, 1, IP, INFO )
125 CALL CHKXER( 'SSYTF2', INFOT, NOUT, LERR, OK )
126 *
127 * SSYTRI
128 *
129 SRNAMT = 'SSYTRI'
130 INFOT = 1
131 CALL SSYTRI( '/', 0, A, 1, IP, W, INFO )
132 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
133 INFOT = 2
134 CALL SSYTRI( 'U', -1, A, 1, IP, W, INFO )
135 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
136 INFOT = 4
137 CALL SSYTRI( 'U', 2, A, 1, IP, W, INFO )
138 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
139 *
140 * SSYTRI2
141 *
142 SRNAMT = 'SSYTRI2'
143 INFOT = 1
144 CALL SSYTRI2( '/', 0, A, 1, IP, W, IW, INFO )
145 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
146 INFOT = 2
147 CALL SSYTRI2( 'U', -1, A, 1, IP, W, IW, INFO )
148 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
149 INFOT = 4
150 CALL SSYTRI2( 'U', 2, A, 1, IP, W, IW, INFO )
151 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
152 *
153 * SSYTRS
154 *
155 SRNAMT = 'SSYTRS'
156 INFOT = 1
157 CALL SSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
158 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
159 INFOT = 2
160 CALL SSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
161 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
162 INFOT = 3
163 CALL SSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
164 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
165 INFOT = 5
166 CALL SSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
167 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
168 INFOT = 8
169 CALL SSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
170 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
171 *
172 * SSYRFS
173 *
174 SRNAMT = 'SSYRFS'
175 INFOT = 1
176 CALL SSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
177 $ IW, INFO )
178 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
179 INFOT = 2
180 CALL SSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
181 $ W, IW, INFO )
182 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
183 INFOT = 3
184 CALL SSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
185 $ W, IW, INFO )
186 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
187 INFOT = 5
188 CALL SSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
189 $ IW, INFO )
190 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
191 INFOT = 7
192 CALL SSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
193 $ IW, INFO )
194 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
195 INFOT = 10
196 CALL SSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
197 $ IW, INFO )
198 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
199 INFOT = 12
200 CALL SSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
201 $ IW, INFO )
202 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
203 *
204 * SSYRFSX
205 *
206 N_ERR_BNDS = 3
207 NPARAMS = 0
208 SRNAMT = 'SSYRFSX'
209 INFOT = 1
210 CALL SSYRFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
211 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
212 $ PARAMS, W, IW, INFO )
213 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK )
214 INFOT = 2
215 CALL SSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
216 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
217 $ PARAMS, W, IW, INFO )
218 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK )
219 EQ = 'N'
220 INFOT = 3
221 CALL SSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
222 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
223 $ PARAMS, W, IW, INFO )
224 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK )
225 INFOT = 4
226 CALL SSYRFSX( 'U', EQ, 0, -1, A, 1, AF, 1, IP, S, B, 1, X, 1,
227 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
228 $ PARAMS, W, IW, INFO )
229 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK )
230 INFOT = 6
231 CALL SSYRFSX( 'U', EQ, 2, 1, A, 1, AF, 2, IP, S, B, 2, X, 2,
232 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
233 $ PARAMS, W, IW, INFO )
234 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK )
235 INFOT = 8
236 CALL SSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 1, IP, S, B, 2, X, 2,
237 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
238 $ PARAMS, W, IW, INFO )
239 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK )
240 INFOT = 11
241 CALL SSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 1, X, 2,
242 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
243 $ PARAMS, W, IW, INFO )
244 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK )
245 INFOT = 13
246 CALL SSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 2, X, 1,
247 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
248 $ PARAMS, W, IW, INFO )
249 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK )
250 *
251 * SSYCON
252 *
253 SRNAMT = 'SSYCON'
254 INFOT = 1
255 CALL SSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, IW, INFO )
256 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
257 INFOT = 2
258 CALL SSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, IW, INFO )
259 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
260 INFOT = 4
261 CALL SSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, IW, INFO )
262 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
263 INFOT = 6
264 CALL SSYCON( 'U', 1, A, 1, IP, -1.0, RCOND, W, IW, INFO )
265 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
266 *
267 ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
268 *
269 * Test error exits of the routines that use the Bunch-Kaufman
270 * factorization of a symmetric indefinite packed matrix.
271 *
272 * SSPTRF
273 *
274 SRNAMT = 'SSPTRF'
275 INFOT = 1
276 CALL SSPTRF( '/', 0, A, IP, INFO )
277 CALL CHKXER( 'SSPTRF', INFOT, NOUT, LERR, OK )
278 INFOT = 2
279 CALL SSPTRF( 'U', -1, A, IP, INFO )
280 CALL CHKXER( 'SSPTRF', INFOT, NOUT, LERR, OK )
281 *
282 * SSPTRI
283 *
284 SRNAMT = 'SSPTRI'
285 INFOT = 1
286 CALL SSPTRI( '/', 0, A, IP, W, INFO )
287 CALL CHKXER( 'SSPTRI', INFOT, NOUT, LERR, OK )
288 INFOT = 2
289 CALL SSPTRI( 'U', -1, A, IP, W, INFO )
290 CALL CHKXER( 'SSPTRI', INFOT, NOUT, LERR, OK )
291 *
292 * SSPTRS
293 *
294 SRNAMT = 'SSPTRS'
295 INFOT = 1
296 CALL SSPTRS( '/', 0, 0, A, IP, B, 1, INFO )
297 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
298 INFOT = 2
299 CALL SSPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
300 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
301 INFOT = 3
302 CALL SSPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
303 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
304 INFOT = 7
305 CALL SSPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
306 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
307 *
308 * SSPRFS
309 *
310 SRNAMT = 'SSPRFS'
311 INFOT = 1
312 CALL SSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
313 $ INFO )
314 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
315 INFOT = 2
316 CALL SSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
317 $ INFO )
318 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
319 INFOT = 3
320 CALL SSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
321 $ INFO )
322 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
323 INFOT = 8
324 CALL SSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, IW,
325 $ INFO )
326 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
327 INFOT = 10
328 CALL SSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, IW,
329 $ INFO )
330 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
331 *
332 * SSPCON
333 *
334 SRNAMT = 'SSPCON'
335 INFOT = 1
336 CALL SSPCON( '/', 0, A, IP, ANRM, RCOND, W, IW, INFO )
337 CALL CHKXER( 'SSPCON', INFOT, NOUT, LERR, OK )
338 INFOT = 2
339 CALL SSPCON( 'U', -1, A, IP, ANRM, RCOND, W, IW, INFO )
340 CALL CHKXER( 'SSPCON', INFOT, NOUT, LERR, OK )
341 INFOT = 5
342 CALL SSPCON( 'U', 1, A, IP, -1.0, RCOND, W, IW, INFO )
343 CALL CHKXER( 'SSPCON', INFOT, NOUT, LERR, OK )
344 END IF
345 *
346 * Print a summary line.
347 *
348 CALL ALAESM( PATH, OK, NOUT )
349 *
350 RETURN
351 *
352 * End of SERRSY
353 *
354 END
2 *
3 * -- LAPACK test routine (version 3.2) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * SERRSY tests the error exits for the REAL routines
16 * for symmetric indefinite matrices.
17 *
18 * Note that this file is used only when the XBLAS are available,
19 * otherwise serrsy.f defines this subroutine.
20 *
21 * Arguments
22 * =========
23 *
24 * PATH (input) CHARACTER*3
25 * The LAPACK path name for the routines to be tested.
26 *
27 * NUNIT (input) INTEGER
28 * The unit number for output.
29 *
30 * =====================================================================
31 *
32 * .. Parameters ..
33 INTEGER NMAX
34 PARAMETER ( NMAX = 4 )
35 * ..
36 * .. Local Scalars ..
37 CHARACTER EQ
38 CHARACTER*2 C2
39 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
40 REAL ANRM, RCOND, BERR
41 * ..
42 * .. Local Arrays ..
43 INTEGER IP( NMAX ), IW( NMAX )
44 REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
45 $ R1( NMAX ), R2( NMAX ), W( 3*NMAX ), X( NMAX ),
46 $ S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
47 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
48 * ..
49 * .. External Functions ..
50 LOGICAL LSAMEN
51 EXTERNAL LSAMEN
52 * ..
53 * .. External Subroutines ..
54 EXTERNAL ALAESM, CHKXER, SSPCON, SSPRFS, SSPTRF, SSPTRI,
55 $ SSPTRS, SSYCON, SSYRFS, SSYTF2, SSYTRF, SSYTRI,
56 $ SSYTRI2, SSYTRS, SSYRFSX
57 * ..
58 * .. Scalars in Common ..
59 LOGICAL LERR, OK
60 CHARACTER*32 SRNAMT
61 INTEGER INFOT, NOUT
62 * ..
63 * .. Common blocks ..
64 COMMON / INFOC / INFOT, NOUT, OK, LERR
65 COMMON / SRNAMC / SRNAMT
66 * ..
67 * .. Intrinsic Functions ..
68 INTRINSIC REAL
69 * ..
70 * .. Executable Statements ..
71 *
72 NOUT = NUNIT
73 WRITE( NOUT, FMT = * )
74 C2 = PATH( 2: 3 )
75 *
76 * Set the variables to innocuous values.
77 *
78 DO 20 J = 1, NMAX
79 DO 10 I = 1, NMAX
80 A( I, J ) = 1. / REAL( I+J )
81 AF( I, J ) = 1. / REAL( I+J )
82 10 CONTINUE
83 B( J ) = 0.
84 R1( J ) = 0.
85 R2( J ) = 0.
86 W( J ) = 0.
87 X( J ) = 0.
88 S( J ) = 0.
89 IP( J ) = J
90 IW( J ) = J
91 20 CONTINUE
92 ANRM = 1.0
93 RCOND = 1.0
94 OK = .TRUE.
95 *
96 IF( LSAMEN( 2, C2, 'SY' ) ) THEN
97 *
98 * Test error exits of the routines that use the Bunch-Kaufman
99 * factorization of a symmetric indefinite matrix.
100 *
101 * SSYTRF
102 *
103 SRNAMT = 'SSYTRF'
104 INFOT = 1
105 CALL SSYTRF( '/', 0, A, 1, IP, W, 1, INFO )
106 CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
107 INFOT = 2
108 CALL SSYTRF( 'U', -1, A, 1, IP, W, 1, INFO )
109 CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
110 INFOT = 4
111 CALL SSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
112 CALL CHKXER( 'SSYTRF', INFOT, NOUT, LERR, OK )
113 *
114 * SSYTF2
115 *
116 SRNAMT = 'SSYTF2'
117 INFOT = 1
118 CALL SSYTF2( '/', 0, A, 1, IP, INFO )
119 CALL CHKXER( 'SSYTF2', INFOT, NOUT, LERR, OK )
120 INFOT = 2
121 CALL SSYTF2( 'U', -1, A, 1, IP, INFO )
122 CALL CHKXER( 'SSYTF2', INFOT, NOUT, LERR, OK )
123 INFOT = 4
124 CALL SSYTF2( 'U', 2, A, 1, IP, INFO )
125 CALL CHKXER( 'SSYTF2', INFOT, NOUT, LERR, OK )
126 *
127 * SSYTRI
128 *
129 SRNAMT = 'SSYTRI'
130 INFOT = 1
131 CALL SSYTRI( '/', 0, A, 1, IP, W, INFO )
132 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
133 INFOT = 2
134 CALL SSYTRI( 'U', -1, A, 1, IP, W, INFO )
135 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
136 INFOT = 4
137 CALL SSYTRI( 'U', 2, A, 1, IP, W, INFO )
138 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
139 *
140 * SSYTRI2
141 *
142 SRNAMT = 'SSYTRI2'
143 INFOT = 1
144 CALL SSYTRI2( '/', 0, A, 1, IP, W, IW, INFO )
145 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
146 INFOT = 2
147 CALL SSYTRI2( 'U', -1, A, 1, IP, W, IW, INFO )
148 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
149 INFOT = 4
150 CALL SSYTRI2( 'U', 2, A, 1, IP, W, IW, INFO )
151 CALL CHKXER( 'SSYTRI', INFOT, NOUT, LERR, OK )
152 *
153 * SSYTRS
154 *
155 SRNAMT = 'SSYTRS'
156 INFOT = 1
157 CALL SSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
158 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
159 INFOT = 2
160 CALL SSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
161 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
162 INFOT = 3
163 CALL SSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
164 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
165 INFOT = 5
166 CALL SSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
167 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
168 INFOT = 8
169 CALL SSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
170 CALL CHKXER( 'SSYTRS', INFOT, NOUT, LERR, OK )
171 *
172 * SSYRFS
173 *
174 SRNAMT = 'SSYRFS'
175 INFOT = 1
176 CALL SSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
177 $ IW, INFO )
178 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
179 INFOT = 2
180 CALL SSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
181 $ W, IW, INFO )
182 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
183 INFOT = 3
184 CALL SSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
185 $ W, IW, INFO )
186 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
187 INFOT = 5
188 CALL SSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
189 $ IW, INFO )
190 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
191 INFOT = 7
192 CALL SSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
193 $ IW, INFO )
194 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
195 INFOT = 10
196 CALL SSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
197 $ IW, INFO )
198 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
199 INFOT = 12
200 CALL SSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
201 $ IW, INFO )
202 CALL CHKXER( 'SSYRFS', INFOT, NOUT, LERR, OK )
203 *
204 * SSYRFSX
205 *
206 N_ERR_BNDS = 3
207 NPARAMS = 0
208 SRNAMT = 'SSYRFSX'
209 INFOT = 1
210 CALL SSYRFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
211 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
212 $ PARAMS, W, IW, INFO )
213 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK )
214 INFOT = 2
215 CALL SSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
216 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
217 $ PARAMS, W, IW, INFO )
218 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK )
219 EQ = 'N'
220 INFOT = 3
221 CALL SSYRFSX( 'U', EQ, -1, 0, A, 1, AF, 1, IP, S, B, 1, X, 1,
222 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
223 $ PARAMS, W, IW, INFO )
224 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK )
225 INFOT = 4
226 CALL SSYRFSX( 'U', EQ, 0, -1, A, 1, AF, 1, IP, S, B, 1, X, 1,
227 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
228 $ PARAMS, W, IW, INFO )
229 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK )
230 INFOT = 6
231 CALL SSYRFSX( 'U', EQ, 2, 1, A, 1, AF, 2, IP, S, B, 2, X, 2,
232 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
233 $ PARAMS, W, IW, INFO )
234 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK )
235 INFOT = 8
236 CALL SSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 1, IP, S, B, 2, X, 2,
237 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
238 $ PARAMS, W, IW, INFO )
239 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK )
240 INFOT = 11
241 CALL SSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 1, X, 2,
242 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
243 $ PARAMS, W, IW, INFO )
244 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK )
245 INFOT = 13
246 CALL SSYRFSX( 'U', EQ, 2, 1, A, 2, AF, 2, IP, S, B, 2, X, 1,
247 $ RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
248 $ PARAMS, W, IW, INFO )
249 CALL CHKXER( 'SSYRFSX', INFOT, NOUT, LERR, OK )
250 *
251 * SSYCON
252 *
253 SRNAMT = 'SSYCON'
254 INFOT = 1
255 CALL SSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, IW, INFO )
256 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
257 INFOT = 2
258 CALL SSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, IW, INFO )
259 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
260 INFOT = 4
261 CALL SSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, IW, INFO )
262 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
263 INFOT = 6
264 CALL SSYCON( 'U', 1, A, 1, IP, -1.0, RCOND, W, IW, INFO )
265 CALL CHKXER( 'SSYCON', INFOT, NOUT, LERR, OK )
266 *
267 ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
268 *
269 * Test error exits of the routines that use the Bunch-Kaufman
270 * factorization of a symmetric indefinite packed matrix.
271 *
272 * SSPTRF
273 *
274 SRNAMT = 'SSPTRF'
275 INFOT = 1
276 CALL SSPTRF( '/', 0, A, IP, INFO )
277 CALL CHKXER( 'SSPTRF', INFOT, NOUT, LERR, OK )
278 INFOT = 2
279 CALL SSPTRF( 'U', -1, A, IP, INFO )
280 CALL CHKXER( 'SSPTRF', INFOT, NOUT, LERR, OK )
281 *
282 * SSPTRI
283 *
284 SRNAMT = 'SSPTRI'
285 INFOT = 1
286 CALL SSPTRI( '/', 0, A, IP, W, INFO )
287 CALL CHKXER( 'SSPTRI', INFOT, NOUT, LERR, OK )
288 INFOT = 2
289 CALL SSPTRI( 'U', -1, A, IP, W, INFO )
290 CALL CHKXER( 'SSPTRI', INFOT, NOUT, LERR, OK )
291 *
292 * SSPTRS
293 *
294 SRNAMT = 'SSPTRS'
295 INFOT = 1
296 CALL SSPTRS( '/', 0, 0, A, IP, B, 1, INFO )
297 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
298 INFOT = 2
299 CALL SSPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
300 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
301 INFOT = 3
302 CALL SSPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
303 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
304 INFOT = 7
305 CALL SSPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
306 CALL CHKXER( 'SSPTRS', INFOT, NOUT, LERR, OK )
307 *
308 * SSPRFS
309 *
310 SRNAMT = 'SSPRFS'
311 INFOT = 1
312 CALL SSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
313 $ INFO )
314 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
315 INFOT = 2
316 CALL SSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
317 $ INFO )
318 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
319 INFOT = 3
320 CALL SSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
321 $ INFO )
322 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
323 INFOT = 8
324 CALL SSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, IW,
325 $ INFO )
326 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
327 INFOT = 10
328 CALL SSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, IW,
329 $ INFO )
330 CALL CHKXER( 'SSPRFS', INFOT, NOUT, LERR, OK )
331 *
332 * SSPCON
333 *
334 SRNAMT = 'SSPCON'
335 INFOT = 1
336 CALL SSPCON( '/', 0, A, IP, ANRM, RCOND, W, IW, INFO )
337 CALL CHKXER( 'SSPCON', INFOT, NOUT, LERR, OK )
338 INFOT = 2
339 CALL SSPCON( 'U', -1, A, IP, ANRM, RCOND, W, IW, INFO )
340 CALL CHKXER( 'SSPCON', INFOT, NOUT, LERR, OK )
341 INFOT = 5
342 CALL SSPCON( 'U', 1, A, IP, -1.0, RCOND, W, IW, INFO )
343 CALL CHKXER( 'SSPCON', INFOT, NOUT, LERR, OK )
344 END IF
345 *
346 * Print a summary line.
347 *
348 CALL ALAESM( PATH, OK, NOUT )
349 *
350 RETURN
351 *
352 * End of SERRSY
353 *
354 END