LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
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,
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
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
subroutine derrsy(PATH, NUNIT)
DERRSY
Definition: derrsy.f:55
subroutine dsptri(UPLO, N, AP, IPIV, WORK, INFO)
DSPTRI
Definition: dsptri.f:109
subroutine dsptrf(UPLO, N, AP, IPIV, INFO)
DSPTRF
Definition: dsptrf.f:159
subroutine dsprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DSPRFS
Definition: dsprfs.f:179
subroutine dsptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
DSPTRS
Definition: dsptrs.f:115
subroutine dspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSPCON
Definition: dspcon.f:125
subroutine dsytri2x(UPLO, N, A, LDA, IPIV, WORK, NB, INFO)
DSYTRI2X
Definition: dsytri2x.f:120
subroutine dsytri_3x(UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO)
DSYTRI_3X
Definition: dsytri_3x.f:159
subroutine dsycon_3(UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON_3
Definition: dsycon_3.f:171
subroutine dsytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF_ROOK
Definition: dsytrf_rook.f:208
subroutine dsycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON
Definition: dsycon.f:130
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
subroutine dsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS
Definition: dsytrs.f:120
subroutine dsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRI2
Definition: dsytri2.f:127
subroutine dsytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS_ROOK
Definition: dsytrs_rook.f:136
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
subroutine dsytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
DSYTRI
Definition: dsytri.f:114
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
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
subroutine dsytri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
DSYTRI_3
Definition: dsytri_3.f:170
subroutine dsytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
DSYTRI_ROOK
Definition: dsytri_rook.f:129
subroutine dsycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON_ROOK
Definition: dsycon_rook.f:144
subroutine dsyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DSYRFS
Definition: dsyrfs.f:191
subroutine dsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF
Definition: dsytrf.f:182
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
subroutine dsytrs_3(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO)
DSYTRS_3
Definition: dsytrs_3.f:165