1 SUBROUTINE DERRSY( PATH, NUNIT )
2 *
3 * -- LAPACK test routine (version 3.2.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * April 2009
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * DERRSY tests the error exits for the DOUBLE PRECISION routines
16 * for symmetric indefinite matrices.
17 *
18 * Note that this file is used only when the XBLAS are available,
19 * otherwise derrsy.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 DOUBLE PRECISION ANRM, RCOND, BERR
41 * ..
42 * .. Local Arrays ..
43 INTEGER IP( NMAX ), IW( NMAX )
44 DOUBLE PRECISION 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, DSPCON, DSPRFS, DSPTRF, DSPTRI,
55 $ DSPTRS, DSYCON, DSYRFS, DSYTF2, DSYTRF, DSYTRI,
56 $ DSYTRI2, DSYTRS, DSYRFSX
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 DBLE
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.D0 / DBLE( I+J )
81 AF( I, J ) = 1.D0 / DBLE( I+J )
82 10 CONTINUE
83 B( J ) = 0.D0
84 R1( J ) = 0.D0
85 R2( J ) = 0.D0
86 W( J ) = 0.D0
87 X( J ) = 0.D0
88 S( J ) = 0.D0
89 IP( J ) = J
90 IW( J ) = J
91 20 CONTINUE
92 ANRM = 1.0D0
93 RCOND = 1.0D0
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 * DSYTRF
102 *
103 SRNAMT = 'DSYTRF'
104 INFOT = 1
105 CALL DSYTRF( '/', 0, A, 1, IP, W, 1, INFO )
106 CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK )
107 INFOT = 2
108 CALL DSYTRF( 'U', -1, A, 1, IP, W, 1, INFO )
109 CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK )
110 INFOT = 4
111 CALL DSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
112 CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK )
113 *
114 * DSYTF2
115 *
116 SRNAMT = 'DSYTF2'
117 INFOT = 1
118 CALL DSYTF2( '/', 0, A, 1, IP, INFO )
119 CALL CHKXER( 'DSYTF2', INFOT, NOUT, LERR, OK )
120 INFOT = 2
121 CALL DSYTF2( 'U', -1, A, 1, IP, INFO )
122 CALL CHKXER( 'DSYTF2', INFOT, NOUT, LERR, OK )
123 INFOT = 4
124 CALL DSYTF2( 'U', 2, A, 1, IP, INFO )
125 CALL CHKXER( 'DSYTF2', INFOT, NOUT, LERR, OK )
126 *
127 * DSYTRI
128 *
129 SRNAMT = 'DSYTRI'
130 INFOT = 1
131 CALL DSYTRI( '/', 0, A, 1, IP, W, INFO )
132 CALL CHKXER( 'DSYTRI', INFOT, NOUT, LERR, OK )
133 INFOT = 2
134 CALL DSYTRI( 'U', -1, A, 1, IP, W, INFO )
135 CALL CHKXER( 'DSYTRI', INFOT, NOUT, LERR, OK )
136 INFOT = 4
137 CALL DSYTRI( 'U', 2, A, 1, IP, W, INFO )
138 CALL CHKXER( 'DSYTRI', INFOT, NOUT, LERR, OK )
139 *
140 * DSYTRI2
141 *
142 SRNAMT = 'DSYTRI2'
143 INFOT = 1
144 CALL DSYTRI2( '/', 0, A, 1, IP, W, IW, INFO )
145 CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK )
146 INFOT = 2
147 CALL DSYTRI2( 'U', -1, A, 1, IP, W, IW, INFO )
148 CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK )
149 INFOT = 4
150 CALL DSYTRI2( 'U', 2, A, 1, IP, W, IW, INFO )
151 CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK )
152 *
153 * DSYTRS
154 *
155 SRNAMT = 'DSYTRS'
156 INFOT = 1
157 CALL DSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
158 CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
159 INFOT = 2
160 CALL DSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
161 CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
162 INFOT = 3
163 CALL DSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
164 CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
165 INFOT = 5
166 CALL DSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
167 CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
168 INFOT = 8
169 CALL DSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
170 CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
171 *
172 * DSYRFS
173 *
174 SRNAMT = 'DSYRFS'
175 INFOT = 1
176 CALL DSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
177 $ IW, INFO )
178 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
179 INFOT = 2
180 CALL DSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
181 $ W, IW, INFO )
182 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
183 INFOT = 3
184 CALL DSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
185 $ W, IW, INFO )
186 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
187 INFOT = 5
188 CALL DSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
189 $ IW, INFO )
190 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
191 INFOT = 7
192 CALL DSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
193 $ IW, INFO )
194 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
195 INFOT = 10
196 CALL DSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
197 $ IW, INFO )
198 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
199 INFOT = 12
200 CALL DSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
201 $ IW, INFO )
202 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
203 *
204 * DSYRFSX
205 *
206 N_ERR_BNDS = 3
207 NPARAMS = 0
208 SRNAMT = 'DSYRFSX'
209 INFOT = 1
210 CALL DSYRFSX( '/', 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( 'DSYRFSX', INFOT, NOUT, LERR, OK )
214 INFOT = 2
215 CALL DSYRFSX( '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( 'DSYRFSX', INFOT, NOUT, LERR, OK )
219 EQ = 'N'
220 INFOT = 3
221 CALL DSYRFSX( '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( 'DSYRFSX', INFOT, NOUT, LERR, OK )
225 INFOT = 4
226 CALL DSYRFSX( '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( 'DSYRFSX', INFOT, NOUT, LERR, OK )
230 INFOT = 6
231 CALL DSYRFSX( '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( 'DSYRFSX', INFOT, NOUT, LERR, OK )
235 INFOT = 8
236 CALL DSYRFSX( '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( 'DSYRFSX', INFOT, NOUT, LERR, OK )
240 INFOT = 11
241 CALL DSYRFSX( '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( 'DSYRFSX', INFOT, NOUT, LERR, OK )
245 INFOT = 13
246 CALL DSYRFSX( '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( 'DSYRFSX', INFOT, NOUT, LERR, OK )
250 *
251 * DSYCON
252 *
253 SRNAMT = 'DSYCON'
254 INFOT = 1
255 CALL DSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, IW, INFO )
256 CALL CHKXER( 'DSYCON', INFOT, NOUT, LERR, OK )
257 INFOT = 2
258 CALL DSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, IW, INFO )
259 CALL CHKXER( 'DSYCON', INFOT, NOUT, LERR, OK )
260 INFOT = 4
261 CALL DSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, IW, INFO )
262 CALL CHKXER( 'DSYCON', INFOT, NOUT, LERR, OK )
263 INFOT = 6
264 CALL DSYCON( 'U', 1, A, 1, IP, -1.0D0, RCOND, W, IW, INFO )
265 CALL CHKXER( 'DSYCON', 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 * DSPTRF
273 *
274 SRNAMT = 'DSPTRF'
275 INFOT = 1
276 CALL DSPTRF( '/', 0, A, IP, INFO )
277 CALL CHKXER( 'DSPTRF', INFOT, NOUT, LERR, OK )
278 INFOT = 2
279 CALL DSPTRF( 'U', -1, A, IP, INFO )
280 CALL CHKXER( 'DSPTRF', INFOT, NOUT, LERR, OK )
281 *
282 * DSPTRI
283 *
284 SRNAMT = 'DSPTRI'
285 INFOT = 1
286 CALL DSPTRI( '/', 0, A, IP, W, INFO )
287 CALL CHKXER( 'DSPTRI', INFOT, NOUT, LERR, OK )
288 INFOT = 2
289 CALL DSPTRI( 'U', -1, A, IP, W, INFO )
290 CALL CHKXER( 'DSPTRI', INFOT, NOUT, LERR, OK )
291 *
292 * DSPTRS
293 *
294 SRNAMT = 'DSPTRS'
295 INFOT = 1
296 CALL DSPTRS( '/', 0, 0, A, IP, B, 1, INFO )
297 CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK )
298 INFOT = 2
299 CALL DSPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
300 CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK )
301 INFOT = 3
302 CALL DSPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
303 CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK )
304 INFOT = 7
305 CALL DSPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
306 CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK )
307 *
308 * DSPRFS
309 *
310 SRNAMT = 'DSPRFS'
311 INFOT = 1
312 CALL DSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
313 $ INFO )
314 CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
315 INFOT = 2
316 CALL DSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
317 $ INFO )
318 CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
319 INFOT = 3
320 CALL DSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
321 $ INFO )
322 CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
323 INFOT = 8
324 CALL DSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, IW,
325 $ INFO )
326 CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
327 INFOT = 10
328 CALL DSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, IW,
329 $ INFO )
330 CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
331 *
332 * DSPCON
333 *
334 SRNAMT = 'DSPCON'
335 INFOT = 1
336 CALL DSPCON( '/', 0, A, IP, ANRM, RCOND, W, IW, INFO )
337 CALL CHKXER( 'DSPCON', INFOT, NOUT, LERR, OK )
338 INFOT = 2
339 CALL DSPCON( 'U', -1, A, IP, ANRM, RCOND, W, IW, INFO )
340 CALL CHKXER( 'DSPCON', INFOT, NOUT, LERR, OK )
341 INFOT = 5
342 CALL DSPCON( 'U', 1, A, IP, -1.0D0, RCOND, W, IW, INFO )
343 CALL CHKXER( 'DSPCON', 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 DERRSY
353 *
354 END
2 *
3 * -- LAPACK test routine (version 3.2.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * April 2009
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * DERRSY tests the error exits for the DOUBLE PRECISION routines
16 * for symmetric indefinite matrices.
17 *
18 * Note that this file is used only when the XBLAS are available,
19 * otherwise derrsy.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 DOUBLE PRECISION ANRM, RCOND, BERR
41 * ..
42 * .. Local Arrays ..
43 INTEGER IP( NMAX ), IW( NMAX )
44 DOUBLE PRECISION 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, DSPCON, DSPRFS, DSPTRF, DSPTRI,
55 $ DSPTRS, DSYCON, DSYRFS, DSYTF2, DSYTRF, DSYTRI,
56 $ DSYTRI2, DSYTRS, DSYRFSX
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 DBLE
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.D0 / DBLE( I+J )
81 AF( I, J ) = 1.D0 / DBLE( I+J )
82 10 CONTINUE
83 B( J ) = 0.D0
84 R1( J ) = 0.D0
85 R2( J ) = 0.D0
86 W( J ) = 0.D0
87 X( J ) = 0.D0
88 S( J ) = 0.D0
89 IP( J ) = J
90 IW( J ) = J
91 20 CONTINUE
92 ANRM = 1.0D0
93 RCOND = 1.0D0
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 * DSYTRF
102 *
103 SRNAMT = 'DSYTRF'
104 INFOT = 1
105 CALL DSYTRF( '/', 0, A, 1, IP, W, 1, INFO )
106 CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK )
107 INFOT = 2
108 CALL DSYTRF( 'U', -1, A, 1, IP, W, 1, INFO )
109 CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK )
110 INFOT = 4
111 CALL DSYTRF( 'U', 2, A, 1, IP, W, 4, INFO )
112 CALL CHKXER( 'DSYTRF', INFOT, NOUT, LERR, OK )
113 *
114 * DSYTF2
115 *
116 SRNAMT = 'DSYTF2'
117 INFOT = 1
118 CALL DSYTF2( '/', 0, A, 1, IP, INFO )
119 CALL CHKXER( 'DSYTF2', INFOT, NOUT, LERR, OK )
120 INFOT = 2
121 CALL DSYTF2( 'U', -1, A, 1, IP, INFO )
122 CALL CHKXER( 'DSYTF2', INFOT, NOUT, LERR, OK )
123 INFOT = 4
124 CALL DSYTF2( 'U', 2, A, 1, IP, INFO )
125 CALL CHKXER( 'DSYTF2', INFOT, NOUT, LERR, OK )
126 *
127 * DSYTRI
128 *
129 SRNAMT = 'DSYTRI'
130 INFOT = 1
131 CALL DSYTRI( '/', 0, A, 1, IP, W, INFO )
132 CALL CHKXER( 'DSYTRI', INFOT, NOUT, LERR, OK )
133 INFOT = 2
134 CALL DSYTRI( 'U', -1, A, 1, IP, W, INFO )
135 CALL CHKXER( 'DSYTRI', INFOT, NOUT, LERR, OK )
136 INFOT = 4
137 CALL DSYTRI( 'U', 2, A, 1, IP, W, INFO )
138 CALL CHKXER( 'DSYTRI', INFOT, NOUT, LERR, OK )
139 *
140 * DSYTRI2
141 *
142 SRNAMT = 'DSYTRI2'
143 INFOT = 1
144 CALL DSYTRI2( '/', 0, A, 1, IP, W, IW, INFO )
145 CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK )
146 INFOT = 2
147 CALL DSYTRI2( 'U', -1, A, 1, IP, W, IW, INFO )
148 CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK )
149 INFOT = 4
150 CALL DSYTRI2( 'U', 2, A, 1, IP, W, IW, INFO )
151 CALL CHKXER( 'DSYTRI2', INFOT, NOUT, LERR, OK )
152 *
153 * DSYTRS
154 *
155 SRNAMT = 'DSYTRS'
156 INFOT = 1
157 CALL DSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
158 CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
159 INFOT = 2
160 CALL DSYTRS( 'U', -1, 0, A, 1, IP, B, 1, INFO )
161 CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
162 INFOT = 3
163 CALL DSYTRS( 'U', 0, -1, A, 1, IP, B, 1, INFO )
164 CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
165 INFOT = 5
166 CALL DSYTRS( 'U', 2, 1, A, 1, IP, B, 2, INFO )
167 CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
168 INFOT = 8
169 CALL DSYTRS( 'U', 2, 1, A, 2, IP, B, 1, INFO )
170 CALL CHKXER( 'DSYTRS', INFOT, NOUT, LERR, OK )
171 *
172 * DSYRFS
173 *
174 SRNAMT = 'DSYRFS'
175 INFOT = 1
176 CALL DSYRFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
177 $ IW, INFO )
178 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
179 INFOT = 2
180 CALL DSYRFS( 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
181 $ W, IW, INFO )
182 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
183 INFOT = 3
184 CALL DSYRFS( 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
185 $ W, IW, INFO )
186 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
187 INFOT = 5
188 CALL DSYRFS( 'U', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
189 $ IW, INFO )
190 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
191 INFOT = 7
192 CALL DSYRFS( 'U', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
193 $ IW, INFO )
194 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
195 INFOT = 10
196 CALL DSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
197 $ IW, INFO )
198 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
199 INFOT = 12
200 CALL DSYRFS( 'U', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
201 $ IW, INFO )
202 CALL CHKXER( 'DSYRFS', INFOT, NOUT, LERR, OK )
203 *
204 * DSYRFSX
205 *
206 N_ERR_BNDS = 3
207 NPARAMS = 0
208 SRNAMT = 'DSYRFSX'
209 INFOT = 1
210 CALL DSYRFSX( '/', 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( 'DSYRFSX', INFOT, NOUT, LERR, OK )
214 INFOT = 2
215 CALL DSYRFSX( '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( 'DSYRFSX', INFOT, NOUT, LERR, OK )
219 EQ = 'N'
220 INFOT = 3
221 CALL DSYRFSX( '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( 'DSYRFSX', INFOT, NOUT, LERR, OK )
225 INFOT = 4
226 CALL DSYRFSX( '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( 'DSYRFSX', INFOT, NOUT, LERR, OK )
230 INFOT = 6
231 CALL DSYRFSX( '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( 'DSYRFSX', INFOT, NOUT, LERR, OK )
235 INFOT = 8
236 CALL DSYRFSX( '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( 'DSYRFSX', INFOT, NOUT, LERR, OK )
240 INFOT = 11
241 CALL DSYRFSX( '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( 'DSYRFSX', INFOT, NOUT, LERR, OK )
245 INFOT = 13
246 CALL DSYRFSX( '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( 'DSYRFSX', INFOT, NOUT, LERR, OK )
250 *
251 * DSYCON
252 *
253 SRNAMT = 'DSYCON'
254 INFOT = 1
255 CALL DSYCON( '/', 0, A, 1, IP, ANRM, RCOND, W, IW, INFO )
256 CALL CHKXER( 'DSYCON', INFOT, NOUT, LERR, OK )
257 INFOT = 2
258 CALL DSYCON( 'U', -1, A, 1, IP, ANRM, RCOND, W, IW, INFO )
259 CALL CHKXER( 'DSYCON', INFOT, NOUT, LERR, OK )
260 INFOT = 4
261 CALL DSYCON( 'U', 2, A, 1, IP, ANRM, RCOND, W, IW, INFO )
262 CALL CHKXER( 'DSYCON', INFOT, NOUT, LERR, OK )
263 INFOT = 6
264 CALL DSYCON( 'U', 1, A, 1, IP, -1.0D0, RCOND, W, IW, INFO )
265 CALL CHKXER( 'DSYCON', 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 * DSPTRF
273 *
274 SRNAMT = 'DSPTRF'
275 INFOT = 1
276 CALL DSPTRF( '/', 0, A, IP, INFO )
277 CALL CHKXER( 'DSPTRF', INFOT, NOUT, LERR, OK )
278 INFOT = 2
279 CALL DSPTRF( 'U', -1, A, IP, INFO )
280 CALL CHKXER( 'DSPTRF', INFOT, NOUT, LERR, OK )
281 *
282 * DSPTRI
283 *
284 SRNAMT = 'DSPTRI'
285 INFOT = 1
286 CALL DSPTRI( '/', 0, A, IP, W, INFO )
287 CALL CHKXER( 'DSPTRI', INFOT, NOUT, LERR, OK )
288 INFOT = 2
289 CALL DSPTRI( 'U', -1, A, IP, W, INFO )
290 CALL CHKXER( 'DSPTRI', INFOT, NOUT, LERR, OK )
291 *
292 * DSPTRS
293 *
294 SRNAMT = 'DSPTRS'
295 INFOT = 1
296 CALL DSPTRS( '/', 0, 0, A, IP, B, 1, INFO )
297 CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK )
298 INFOT = 2
299 CALL DSPTRS( 'U', -1, 0, A, IP, B, 1, INFO )
300 CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK )
301 INFOT = 3
302 CALL DSPTRS( 'U', 0, -1, A, IP, B, 1, INFO )
303 CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK )
304 INFOT = 7
305 CALL DSPTRS( 'U', 2, 1, A, IP, B, 1, INFO )
306 CALL CHKXER( 'DSPTRS', INFOT, NOUT, LERR, OK )
307 *
308 * DSPRFS
309 *
310 SRNAMT = 'DSPRFS'
311 INFOT = 1
312 CALL DSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
313 $ INFO )
314 CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
315 INFOT = 2
316 CALL DSPRFS( 'U', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
317 $ INFO )
318 CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
319 INFOT = 3
320 CALL DSPRFS( 'U', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
321 $ INFO )
322 CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
323 INFOT = 8
324 CALL DSPRFS( 'U', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, IW,
325 $ INFO )
326 CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
327 INFOT = 10
328 CALL DSPRFS( 'U', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, IW,
329 $ INFO )
330 CALL CHKXER( 'DSPRFS', INFOT, NOUT, LERR, OK )
331 *
332 * DSPCON
333 *
334 SRNAMT = 'DSPCON'
335 INFOT = 1
336 CALL DSPCON( '/', 0, A, IP, ANRM, RCOND, W, IW, INFO )
337 CALL CHKXER( 'DSPCON', INFOT, NOUT, LERR, OK )
338 INFOT = 2
339 CALL DSPCON( 'U', -1, A, IP, ANRM, RCOND, W, IW, INFO )
340 CALL CHKXER( 'DSPCON', INFOT, NOUT, LERR, OK )
341 INFOT = 5
342 CALL DSPCON( 'U', 1, A, IP, -1.0D0, RCOND, W, IW, INFO )
343 CALL CHKXER( 'DSPCON', 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 DERRSY
353 *
354 END