OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
derrsyx.f
Go to the documentation of this file.
1*> \brief \b DERRSYX
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 DERRSY( 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*> DERRSY tests the error exits for the DOUBLE PRECISION routines
25*> for symmetric indefinite matrices.
26*>
27*> Note that this file is used only when the XBLAS are available,
28*> otherwise derrsy.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 double_lin
55*
56* =====================================================================
57 SUBROUTINE derrsy( 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 DOUBLE PRECISION ANRM, RCOND, BERR
79* ..
80* .. Local Arrays ..
81 INTEGER IP( NMAX ), IW( NMAX )
82 DOUBLE PRECISION 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, dspcon, dsprfs, dsptrf, dsptri,
93 $ dsptrs, dsycon, dsycon_3, dsycon_rook, dsyrfs,
94 $ dsytf2, dsytf2_rk, dsytf2_rook, dsytrf,
95 $ dsytrf_rk, dsytrf_rook, dsytri, dsytri_3,
96 $ dsytri_3x, dsytri_rook, dsytri2, dsytri2x,
97 $ dsytrs, dsytrs_3, dsytrs_rook, dsyrfsx
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 dble
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.d0 / dble( i+j )
122 af( i, j ) = 1.d0 / dble( i+j )
123 10 CONTINUE
124 b( j ) = 0.d0
125 e( j ) = 0.d0
126 r1( j ) = 0.d0
127 r2( j ) = 0.d0
128 w( j ) = 0.d0
129 x( j ) = 0.d0
130 s( j ) = 0.d0
131 ip( j ) = j
132 iw( j ) = j
133 20 CONTINUE
134 anrm = 1.0d0
135 rcond = 1.0d0
136 ok = .true.
137*
138 IF( lsamen( 2, c2, 'SY' ) ) THEN
139*
140* Test error exits of the routines that use factorization
141* of a symmetric indefinite matrix with patrial
142* (Bunch-Kaufman) pivoting.
143*
144* DSYTRF
145*
146 srnamt = 'DSYTRF'
147 infot = 1
148 CALL dsytrf( '/', 0, a, 1, ip, w, 1, info )
149 CALL chkxer( 'DSYTRF', infot, nout, lerr, ok )
150 infot = 2
151 CALL dsytrf( 'U', -1, a, 1, ip, w, 1, info )
152 CALL chkxer( 'DSYTRF', infot, nout, lerr, ok )
153 infot = 4
154 CALL dsytrf( 'U', 2, a, 1, ip, w, 4, info )
155 CALL chkxer( 'DSYTRF', infot, nout, lerr, ok )
156 infot = 7
157 CALL dsytrf( 'U', 0, a, 1, ip, w, 0, info )
158 CALL chkxer( 'DSYTRF', infot, nout, lerr, ok )
159 infot = 7
160 CALL dsytrf( 'U', 0, a, 1, ip, w, -2, info )
161 CALL chkxer( 'DSYTRF', infot, nout, lerr, ok )
162*
163* DSYTF2
164*
165 srnamt = 'DSYTF2'
166 infot = 1
167 CALL dsytf2( '/', 0, a, 1, ip, info )
168 CALL chkxer( 'DSYTF2', infot, nout, lerr, ok )
169 infot = 2
170 CALL dsytf2( 'U', -1, a, 1, ip, info )
171 CALL chkxer( 'DSYTF2', infot, nout, lerr, ok )
172 infot = 4
173 CALL dsytf2( 'U', 2, a, 1, ip, info )
174 CALL chkxer( 'dsytf2', INFOT, NOUT, LERR, OK )
175*
176* DSYTRI
177*
178 SRNAMT = 'dsytri'
179 INFOT = 1
180 CALL DSYTRI( '/', 0, A, 1, IP, W, INFO )
181 CALL CHKXER( 'dsytri', INFOT, NOUT, LERR, OK )
182 INFOT = 2
183 CALL DSYTRI( 'u', -1, A, 1, IP, W, INFO )
184 CALL CHKXER( 'dsytri', INFOT, NOUT, LERR, OK )
185 INFOT = 4
186 CALL DSYTRI( 'u', 2, A, 1, IP, W, INFO )
187 CALL CHKXER( 'dsytri', INFOT, NOUT, LERR, OK )
188*
189* DSYTRI2
190*
191 SRNAMT = 'dsytri2'
192 INFOT = 1
193 CALL DSYTRI2( '/', 0, A, 1, IP, W, IW, INFO )
194 CALL CHKXER( 'dsytri2', INFOT, NOUT, LERR, OK )
195 INFOT = 2
196 CALL DSYTRI2( 'u', -1, A, 1, IP, W, IW, INFO )
197 CALL CHKXER( 'dsytri2', INFOT, NOUT, LERR, OK )
198 INFOT = 4
199 CALL DSYTRI2( 'u', 2, A, 1, IP, W, IW, INFO )
200 CALL CHKXER( 'dsytri2', INFOT, NOUT, LERR, OK )
201*
202* DSYTRI2X
203*
204 SRNAMT = 'dsytri2x'
205 INFOT = 1
206 CALL DSYTRI2X( '/', 0, A, 1, IP, W, 1, INFO )
207 CALL CHKXER( 'dsytri2x', INFOT, NOUT, LERR, OK )
208 INFOT = 2
209 CALL DSYTRI2X( 'u', -1, A, 1, IP, W, 1, INFO )
210 CALL CHKXER( 'dsytri2x', INFOT, NOUT, LERR, OK )
211 INFOT = 4
212 CALL DSYTRI2X( 'u', 2, A, 1, IP, W, 1, INFO )
213 CALL CHKXER( 'dsytri2x', INFOT, NOUT, LERR, OK )
214*
215* DSYTRS
216*
217 SRNAMT = 'dsytrs'
218 INFOT = 1
219 CALL DSYTRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
220 CALL CHKXER( 'dsytrs', INFOT, NOUT, LERR, OK )
221 INFOT = 2
222 CALL DSYTRS( 'u', -1, 0, A, 1, IP, B, 1, INFO )
223 CALL CHKXER( 'dsytrs', INFOT, NOUT, LERR, OK )
224 INFOT = 3
225 CALL DSYTRS( 'u', 0, -1, A, 1, IP, B, 1, INFO )
226 CALL CHKXER( 'dsytrs', INFOT, NOUT, LERR, OK )
227 INFOT = 5
228 CALL DSYTRS( 'u', 2, 1, A, 1, IP, B, 2, INFO )
229 CALL CHKXER( 'dsytrs', INFOT, NOUT, LERR, OK )
230 INFOT = 8
231 CALL DSYTRS( 'u', 2, 1, A, 2, IP, B, 1, INFO )
232 CALL CHKXER( 'dsytrs', INFOT, NOUT, LERR, OK )
233*
234* DSYRFS
235*
236 SRNAMT = 'dsyrfs'
237 INFOT = 1
238 CALL DSYRFS( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
239 $ iw, info )
240 CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
241 infot = 2
242 CALL dsyrfs( 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
243 $ w, iw, info )
244 CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
245 infot = 3
246 CALL dsyrfs( 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
247 $ w, iw, info )
248 CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
249 infot = 5
250 CALL dsyrfs( 'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
251 $ iw, info )
252 CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
253 infot = 7
254 CALL dsyrfs( 'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
255 $ iw, info )
256 CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
257 infot = 10
258 CALL dsyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
259 $ iw, info )
260 CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
261 infot = 12
262 CALL dsyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
263 $ iw, info )
264 CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
265*
266* DSYRFSX
267*
268 n_err_bnds = 3
269 nparams = 0
270 srnamt = 'DSYRFSX'
271 infot = 1
272 CALL dsyrfsx( '/', eq, 0, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
273 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
274 $ params, w, iw, info )
275 CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
276 infot = 2
277 CALL dsyrfsx( 'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
278 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
279 $ params, w, iw, info )
280 CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
281 eq = 'N'
282 infot = 3
283 CALL dsyrfsx( 'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
284 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
285 $ params, w, iw, info )
286 CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
287 infot = 4
288 CALL dsyrfsx( 'U', eq, 0, -1, a, 1, af, 1, ip, s, b, 1, x, 1,
289 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
290 $ params, w, iw, info )
291 CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
292 infot = 6
293 CALL dsyrfsx( 'U', eq, 2, 1, a, 1, af, 2, ip, s, b, 2, x, 2,
294 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
295 $ params, w, iw, info )
296 CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
297 infot = 8
298 CALL dsyrfsx( 'U', eq, 2, 1, a, 2, af, 1, ip, s, b, 2, x, 2,
299 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
300 $ params, w, iw, info )
301 CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
302 infot = 12
303 CALL dsyrfsx( 'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 1, x, 2,
304 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
305 $ params, w, iw, info )
306 CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
307 infot = 14
308 CALL dsyrfsx( 'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 2, x, 1,
309 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
310 $ params, w, iw, info )
311 CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
312*
313* DSYCON
314*
315 srnamt = 'DSYCON'
316 infot = 1
317 CALL dsycon( '/', 0, A, 1, IP, ANRM, RCOND, W, IW, INFO )
318 CALL CHKXER( 'dsycon', INFOT, NOUT, LERR, OK )
319 INFOT = 2
320 CALL DSYCON( 'u', -1, A, 1, IP, ANRM, RCOND, W, IW, INFO )
321 CALL CHKXER( 'dsycon', INFOT, NOUT, LERR, OK )
322 INFOT = 4
323 CALL DSYCON( 'u', 2, A, 1, IP, ANRM, RCOND, W, IW, INFO )
324 CALL CHKXER( 'dsycon', INFOT, NOUT, LERR, OK )
325 INFOT = 6
326 CALL DSYCON( 'u', 1, A, 1, IP, -1.0D0, RCOND, W, IW, INFO )
327 CALL CHKXER( 'dsycon', INFOT, NOUT, LERR, OK )
328*
329 ELSE IF( LSAMEN( 2, C2, 'sr' ) ) THEN
330*
331* Test error exits of the routines that use factorization
332* of a symmetric indefinite matrix with rook
333* (bounded Bunch-Kaufman) pivoting.
334*
335* DSYTRF_ROOK
336*
337 SRNAMT = 'dsytrf_rook'
338 INFOT = 1
339 CALL DSYTRF_ROOK( '/', 0, A, 1, IP, W, 1, INFO )
340 CALL CHKXER( 'dsytrf_rook', INFOT, NOUT, LERR, OK )
341 INFOT = 2
342 CALL DSYTRF_ROOK( 'u', -1, A, 1, IP, W, 1, INFO )
343 CALL CHKXER( 'dsytrf_rook', INFOT, NOUT, LERR, OK )
344 INFOT = 4
345 CALL DSYTRF_ROOK( 'u', 2, A, 1, IP, W, 4, INFO )
346 CALL CHKXER( 'dsytrf_rook', INFOT, NOUT, LERR, OK )
347 INFOT = 7
348 CALL DSYTRF_ROOK( 'u', 0, A, 1, IP, W, 0, INFO )
349 CALL CHKXER( 'dsytrf_rook', INFOT, NOUT, LERR, OK )
350 INFOT = 7
351 CALL DSYTRF_ROOK( 'u', 0, A, 1, IP, W, -2, INFO )
352 CALL CHKXER( 'dsytrf_rook', INFOT, NOUT, LERR, OK )
353*
354* DSYTF2_ROOK
355*
356 SRNAMT = 'dsytf2_rook'
357 infot = 1
358 CALL dsytf2_rook( '/', 0, a, 1, ip, info )
359 CALL chkxer( 'DSYTF2_ROOK', infot, nout, lerr, ok )
360 infot = 2
361 CALL dsytf2_rook( 'U', -1, a, 1, ip, info )
362 CALL chkxer( 'DSYTF2_ROOK', infot, nout, lerr, ok )
363 infot = 4
364 CALL dsytf2_rook( 'U', 2, a, 1, ip, info )
365 CALL chkxer( 'DSYTF2_ROOK', infot, nout, lerr, ok )
366*
367* DSYTRI_ROOK
368*
369 srnamt = 'DSYTRI_ROOK'
370 infot = 1
371 CALL dsytri_rook( '/', 0, a, 1, ip, w, info )
372 CALL chkxer( 'DSYTRI_ROOK', infot, nout, lerr, ok )
373 infot = 2
374 CALL dsytri_rook( 'U', -1, a, 1, ip, w, info )
375 CALL chkxer( 'DSYTRI_ROOK', infot, nout, lerr, ok )
376 infot = 4
377 CALL dsytri_rook( 'U', 2, a, 1, ip, w, info )
378 CALL chkxer( 'DSYTRI_ROOK', infot, nout, lerr, ok )
379*
380* DSYTRS_ROOK
381*
382 srnamt = 'DSYTRS_ROOK'
383 infot = 1
384 CALL dsytrs_rook( '/', 0, 0, a, 1, ip, b, 1, info )
385 CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
386 infot = 2
387 CALL dsytrs_rook( 'U', -1, 0, a, 1, ip, b, 1, info )
388 CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
389 infot = 3
390 CALL dsytrs_rook( 'U', 0, -1, a, 1, ip, b, 1, info )
391 CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
392 infot = 5
393 CALL dsytrs_rook( 'U', 2, 1, a, 1, ip, b, 2, info )
394 CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
395 infot = 8
396 CALL dsytrs_rook( 'U', 2, 1, a, 2, ip, b, 1, info )
397 CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
398*
399* DSYCON_ROOK
400*
401 srnamt = 'DSYCON_ROOK'
402 infot = 1
403 CALL dsycon_rook( '/', 0, a, 1, ip, anrm, rcond, w, iw, info )
404 CALL chkxer( 'DSYCON_ROOK', infot, nout, lerr, ok )
405 infot = 2
406 CALL dsycon_rook( 'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
407 CALL chkxer( 'DSYCON_ROOK', infot, nout, lerr, ok )
408 infot = 4
409 CALL dsycon_rook( 'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
410 CALL chkxer( 'DSYCON_ROOK', infot, nout, lerr, ok )
411 infot = 6
412 CALL dsycon_rook( 'U', 1, a, 1, ip, -1.0d0, rcond, w, iw, info)
413 CALL chkxer( 'DSYCON_ROOK', infot, nout, lerr, ok )
414*
415 ELSE IF( lsamen( 2, c2, 'SK' ) ) THEN
416*
417* Test error exits of the routines that use factorization
418* of a symmetric indefinite matrix with rook
419* (bounded Bunch-Kaufman) pivoting with the new storage
420* format for factors L ( or U) and D.
421*
422* L (or U) is stored in A, diagonal of D is stored on the
423* diagonal of A, subdiagonal of D is stored in a separate array E.
424*
425* DSYTRF_RK
426*
427 srnamt = 'DSYTRF_RK'
428 infot = 1
429 CALL dsytrf_rk( '/', 0, a, 1, e, ip, w, 1, info )
430 CALL chkxer( 'DSYTRF_RK', infot, nout, lerr, ok )
431 infot = 2
432 CALL dsytrf_rk( 'U', -1, a, 1, e, ip, w, 1, info )
433 CALL chkxer( 'DSYTRF_RK', infot, nout, lerr, ok )
434 infot = 4
435 CALL dsytrf_rk( 'U', 2, a, 1, e, ip, w, 1, info )
436 CALL chkxer( 'DSYTRF_RK', infot, nout, lerr, ok )
437 infot = 8
438 CALL dsytrf_rk( 'U', 0, a, 1, e, ip, w, 0, info )
439 CALL chkxer( 'DSYTRF_RK', infot, nout, lerr, ok )
440 infot = 8
441 CALL dsytrf_rk( 'U', 0, a, 1, e, ip, w, -2, info )
442 CALL chkxer( 'DSYTRF_RK', infot, nout, lerr, ok )
443*
444* DSYTF2_RK
445*
446 srnamt = 'DSYTF2_RK'
447 infot = 1
448 CALL dsytf2_rk( '/', 0, a, 1, e, ip, info )
449 CALL chkxer( 'DSYTF2_RK', infot, nout, lerr, ok )
450 infot = 2
451 CALL dsytf2_rk( 'U', -1, a, 1, e, ip, info )
452 CALL chkxer( 'DSYTF2_RK', infot, nout, lerr, ok )
453 infot = 4
454 CALL dsytf2_rk( 'U', 2, a, 1, e, ip, info )
455 CALL chkxer( 'DSYTF2_RK', infot, nout, lerr, ok )
456*
457* DSYTRI_3
458*
459 srnamt = 'DSYTRI_3'
460 infot = 1
461 CALL dsytri_3( '/', 0, a, 1, e, ip, w, 1, info )
462 CALL chkxer( 'DSYTRI_3', infot, nout, lerr, ok )
463 infot = 2
464 CALL dsytri_3( 'U', -1, a, 1, e, ip, w, 1, info )
465 CALL chkxer( 'DSYTRI_3', infot, nout, lerr, ok )
466 infot = 4
467 CALL dsytri_3( 'U', 2, a, 1, e, ip, w, 1, info )
468 CALL chkxer( 'DSYTRI_3', infot, nout, lerr, ok )
469 infot = 8
470 CALL dsytri_3( 'U', 0, a, 1, e, ip, w, 0, info )
471 CALL chkxer( 'DSYTRI_3', infot, nout, lerr, ok )
472 infot = 8
473 CALL dsytri_3( 'U', 0, a, 1, e, ip, w, -2, info )
474 CALL chkxer( 'DSYTRI_3', infot, nout, lerr, ok )
475*
476* DSYTRI_3X
477*
478 srnamt = 'DSYTRI_3X'
479 infot = 1
480 CALL dsytri_3x( '/', 0, a, 1, e, ip, w, 1, info )
481 CALL chkxer( 'DSYTRI_3X', infot, nout, lerr, ok )
482 infot = 2
483 CALL dsytri_3x( 'U', -1, a, 1, e, ip, w, 1, info )
484 CALL chkxer( 'DSYTRI_3X', infot, nout, lerr, ok )
485 infot = 4
486 CALL dsytri_3x( 'U', 2, a, 1, e, ip, w, 1, info )
487 CALL chkxer( 'DSYTRI_3X', infot, nout, lerr, ok )
488*
489* DSYTRS_3
490*
491 srnamt = 'DSYTRS_3'
492 infot = 1
493 CALL dsytrs_3( '/', 0, 0, a, 1, e, ip, b, 1, info )
494 CALL chkxer( 'DSYTRS_3', infot, nout, lerr, ok )
495 infot = 2
496 CALL dsytrs_3( 'U', -1, 0, a, 1, e, ip, b, 1, info )
497 CALL chkxer( 'DSYTRS_3', infot, nout, lerr, ok )
498 infot = 3
499 CALL dsytrs_3( 'U', 0, -1, a, 1, e, ip, b, 1, info )
500 CALL chkxer( 'DSYTRS_3', infot, nout, lerr, ok )
501 infot = 5
502 CALL dsytrs_3( 'U', 2, 1, a, 1, e, ip, b, 2, info )
503 CALL chkxer( 'dsytrs_3', INFOT, NOUT, LERR, OK )
504 INFOT = 9
505 CALL DSYTRS_3( 'u', 2, 1, A, 2, E, IP, B, 1, INFO )
506 CALL CHKXER( 'dsytrs_3', INFOT, NOUT, LERR, OK )
507*
508* DSYCON_3
509*
510 SRNAMT = 'dsycon_3'
511 INFOT = 1
512 CALL DSYCON_3( '/', 0, A, 1, E, IP, ANRM, RCOND, W, IW,
513 $ INFO )
514 CALL CHKXER( 'dsycon_3', INFOT, NOUT, LERR, OK )
515 INFOT = 2
516 CALL DSYCON_3( 'u', -1, A, 1, E, IP, ANRM, RCOND, W, IW,
517 $ INFO )
518 CALL CHKXER( 'dsycon_3', INFOT, NOUT, LERR, OK )
519 INFOT = 4
520 CALL DSYCON_3( 'u', 2, A, 1, E, IP, ANRM, RCOND, W, IW,
521 $ INFO )
522 CALL CHKXER( 'dsycon_3', INFOT, NOUT, LERR, OK )
523 INFOT = 7
524 CALL DSYCON_3( 'u', 1, A, 1, E, IP, -1.0D0, RCOND, W, IW,
525 $ INFO)
526 CALL CHKXER( 'dsycon_3', INFOT, NOUT, LERR, OK )
527*
528 ELSE IF( LSAMEN( 2, C2, 'sp' ) ) THEN
529*
530* Test error exits of the routines that use factorization
531* of a symmetric indefinite packed matrix with patrial
532* (Bunch-Kaufman) pivoting.
533*
534* DSPTRF
535*
536 SRNAMT = 'dsptrf'
537 INFOT = 1
538 CALL DSPTRF( '/', 0, A, IP, INFO )
539 CALL CHKXER( 'dsptrf', INFOT, NOUT, LERR, OK )
540 INFOT = 2
541 CALL DSPTRF( 'u', -1, A, IP, INFO )
542 CALL CHKXER( 'dsptrf', INFOT, NOUT, LERR, OK )
543*
544* DSPTRI
545*
546 SRNAMT = 'dsptri'
547 INFOT = 1
548 CALL DSPTRI( '/', 0, A, IP, W, INFO )
549 CALL CHKXER( 'dsptri', INFOT, NOUT, LERR, OK )
550 INFOT = 2
551 CALL DSPTRI( 'u', -1, A, IP, W, INFO )
552 CALL CHKXER( 'dsptri', INFOT, NOUT, LERR, OK )
553*
554* DSPTRS
555*
556 SRNAMT = 'dsptrs'
557 INFOT = 1
558 CALL DSPTRS( '/', 0, 0, A, IP, B, 1, INFO )
559 CALL CHKXER( 'dsptrs', INFOT, NOUT, LERR, OK )
560 INFOT = 2
561 CALL DSPTRS( 'u', -1, 0, A, IP, B, 1, INFO )
562 CALL CHKXER( 'dsptrs', INFOT, NOUT, LERR, OK )
563 INFOT = 3
564 CALL DSPTRS( 'u', 0, -1, A, IP, B, 1, INFO )
565 CALL CHKXER( 'dsptrs', INFOT, NOUT, LERR, OK )
566 INFOT = 7
567 CALL DSPTRS( 'u', 2, 1, A, IP, B, 1, INFO )
568 CALL CHKXER( 'dsptrs', INFOT, NOUT, LERR, OK )
569*
570* DSPRFS
571*
572 SRNAMT = 'dsprfs'
573 INFOT = 1
574 CALL DSPRFS( '/', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
575 $ INFO )
576 CALL CHKXER( 'dsprfs', INFOT, NOUT, LERR, OK )
577 INFOT = 2
578 CALL DSPRFS( 'u', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
579 $ INFO )
580 CALL CHKXER( 'dsprfs', INFOT, NOUT, LERR, OK )
581 INFOT = 3
582 CALL DSPRFS( 'u', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, IW,
583 $ INFO )
584 CALL CHKXER( 'dsprfs', INFOT, NOUT, LERR, OK )
585 INFOT = 8
586 CALL DSPRFS( 'u', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, IW,
587 $ INFO )
588 CALL CHKXER( 'dsprfs', INFOT, NOUT, LERR, OK )
589 INFOT = 10
590 CALL DSPRFS( 'u', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, IW,
591 $ INFO )
592 CALL CHKXER( 'dsprfs', INFOT, NOUT, LERR, OK )
593*
594* DSPCON
595*
596 SRNAMT = 'dspcon'
597 INFOT = 1
598 CALL DSPCON( '/', 0, A, IP, ANRM, RCOND, W, IW, INFO )
599 CALL CHKXER( 'dspcon', INFOT, NOUT, LERR, OK )
600 INFOT = 2
601 CALL DSPCON( 'u', -1, A, IP, ANRM, RCOND, W, IW, INFO )
602 CALL CHKXER( 'dspcon', INFOT, NOUT, LERR, OK )
603 INFOT = 5
604 CALL DSPCON( 'u', 1, A, IP, -1.0D0, RCOND, W, IW, INFO )
605 CALL CHKXER( 'dspcon', infot, nout, lerr, ok )
606 END IF
607*
608* Print a summary line.
609*
610 CALL alaesm( path, ok, nout )
611*
612 RETURN
613*
614* End of DERRSYX
615*
616 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
dspcon
subroutine dspcon(uplo, n, ap, ipiv, anorm, rcond, work, iwork, info)
DSPCON
Definition dspcon.f:125
dsprfs
subroutine dsprfs(uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
DSPRFS
Definition dsprfs.f:179
dsptrs
subroutine dsptrs(uplo, n, nrhs, ap, ipiv, b, ldb, info)
DSPTRS
Definition dsptrs.f:115
dsptri
subroutine dsptri(uplo, n, ap, ipiv, work, info)
DSPTRI
Definition dsptri.f:109
dsptrf
subroutine dsptrf(uplo, n, ap, ipiv, info)
DSPTRF
Definition dsptrf.f:159
dsytrf_rook
subroutine dsytrf_rook(uplo, n, a, lda, ipiv, work, lwork, info)
DSYTRF_ROOK
Definition dsytrf_rook.f:208
dsyrfsx
subroutine dsyrfsx(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)
DSYRFSX
Definition dsyrfsx.f:402
dsycon_3
subroutine dsycon_3(uplo, n, a, lda, e, ipiv, anorm, rcond, work, iwork, info)
DSYCON_3
Definition dsycon_3.f:171
dsycon
subroutine dsycon(uplo, n, a, lda, ipiv, anorm, rcond, work, iwork, info)
DSYCON
Definition dsycon.f:130
dsytrf
subroutine dsytrf(uplo, n, a, lda, ipiv, work, lwork, info)
DSYTRF
Definition dsytrf.f:182
dsytri2
subroutine dsytri2(uplo, n, a, lda, ipiv, work, lwork, info)
DSYTRI2
Definition dsytri2.f:127
dsytf2_rk
subroutine dsytf2_rk(uplo, n, a, lda, e, ipiv, info)
DSYTF2_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Ka...
Definition dsytf2_rk.f:241
dsytf2
subroutine dsytf2(uplo, n, a, lda, ipiv, info)
DSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
Definition dsytf2.f:194
dsycon_rook
subroutine dsycon_rook(uplo, n, a, lda, ipiv, anorm, rcond, work, iwork, info)
DSYCON_ROOK
Definition dsycon_rook.f:144
dsytrf_rk
subroutine dsytrf_rk(uplo, n, a, lda, e, ipiv, work, lwork, info)
DSYTRF_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Ka...
Definition dsytrf_rk.f:259
dsytf2_rook
subroutine dsytf2_rook(uplo, n, a, lda, ipiv, info)
DSYTF2_ROOK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-...
Definition dsytf2_rook.f:194
dsytri
subroutine dsytri(uplo, n, a, lda, ipiv, work, info)
DSYTRI
Definition dsytri.f:114
dsyrfs
subroutine dsyrfs(uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
DSYRFS
Definition dsyrfs.f:191
dsytri_rook
subroutine dsytri_rook(uplo, n, a, lda, ipiv, work, info)
DSYTRI_ROOK
Definition dsytri_rook.f:129
dsytri_3x
subroutine dsytri_3x(uplo, n, a, lda, e, ipiv, work, nb, info)
DSYTRI_3X
Definition dsytri_3x.f:159
dsytri2x
subroutine dsytri2x(uplo, n, a, lda, ipiv, work, nb, info)
DSYTRI2X
Definition dsytri2x.f:120
dsytrs_3
subroutine dsytrs_3(uplo, n, nrhs, a, lda, e, ipiv, b, ldb, info)
DSYTRS_3
Definition dsytrs_3.f:165
dsytrs
subroutine dsytrs(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
DSYTRS
Definition dsytrs.f:120
dsytrs_rook
subroutine dsytrs_rook(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
DSYTRS_ROOK
Definition dsytrs_rook.f:136
dsytri_3
subroutine dsytri_3(uplo, n, a, lda, e, ipiv, work, lwork, info)
DSYTRI_3
Definition dsytri_3.f:170
derrsy
subroutine derrsy(path, nunit)
DERRSY
Definition derrsy.f:55