LAPACK  3.9.0
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 *> \date December 2016
55 *
56 *> \ingroup double_lin
57 *
58 * =====================================================================
59  SUBROUTINE derrsy( PATH, NUNIT )
60 *
61 * -- LAPACK test routine (version 3.7.0) --
62 * -- LAPACK is a software package provided by Univ. of Tennessee, --
63 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
64 * December 2016
65 *
66 * .. Scalar Arguments ..
67  CHARACTER*3 PATH
68  INTEGER NUNIT
69 * ..
70 *
71 * =====================================================================
72 *
73 * .. Parameters ..
74  INTEGER NMAX
75  parameter( nmax = 4 )
76 * ..
77 * .. Local Scalars ..
78  CHARACTER EQ
79  CHARACTER*2 C2
80  INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
81  DOUBLE PRECISION ANRM, RCOND, BERR
82 * ..
83 * .. Local Arrays ..
84  INTEGER IP( NMAX ), IW( NMAX )
85  DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
86  $ E( NMAX ), R1( NMAX ), R2( NMAX ), W( 3*NMAX ),
87  $ X( NMAX ), S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
88  $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
89 * ..
90 * .. External Functions ..
91  LOGICAL LSAMEN
92  EXTERNAL lsamen
93 * ..
94 * .. External Subroutines ..
95  EXTERNAL alaesm, chkxer, dspcon, dsprfs, dsptrf, dsptri,
96  $ dsptrs, dsycon, dsycon_3, dsycon_rook, dsyrfs,
97  $ dsytf2, dsytf2_rk, dsytf2_rook, dsytrf,
98  $ dsytrf_rk, dsytrf_rook, dsytri, dsytri_3,
99  $ dsytri_3x, dsytri_rook, dsytri2, dsytri2x,
100  $ dsytrs, dsytrs_3, dsytrs_rook, dsyrfsx
101 * ..
102 * .. Scalars in Common ..
103  LOGICAL LERR, OK
104  CHARACTER*32 SRNAMT
105  INTEGER INFOT, NOUT
106 * ..
107 * .. Common blocks ..
108  COMMON / infoc / infot, nout, ok, lerr
109  COMMON / srnamc / srnamt
110 * ..
111 * .. Intrinsic Functions ..
112  INTRINSIC dble
113 * ..
114 * .. Executable Statements ..
115 *
116  nout = nunit
117  WRITE( nout, fmt = * )
118  c2 = path( 2: 3 )
119 *
120 * Set the variables to innocuous values.
121 *
122  DO 20 j = 1, nmax
123  DO 10 i = 1, nmax
124  a( i, j ) = 1.d0 / dble( i+j )
125  af( i, j ) = 1.d0 / dble( i+j )
126  10 CONTINUE
127  b( j ) = 0.d0
128  e( j ) = 0.d0
129  r1( j ) = 0.d0
130  r2( j ) = 0.d0
131  w( j ) = 0.d0
132  x( j ) = 0.d0
133  s( j ) = 0.d0
134  ip( j ) = j
135  iw( j ) = j
136  20 CONTINUE
137  anrm = 1.0d0
138  rcond = 1.0d0
139  ok = .true.
140 *
141  IF( lsamen( 2, c2, 'SY' ) ) THEN
142 *
143 * Test error exits of the routines that use factorization
144 * of a symmetric indefinite matrix with patrial
145 * (Bunch-Kaufman) pivoting.
146 *
147 * DSYTRF
148 *
149  srnamt = 'DSYTRF'
150  infot = 1
151  CALL dsytrf( '/', 0, a, 1, ip, w, 1, info )
152  CALL chkxer( 'DSYTRF', infot, nout, lerr, ok )
153  infot = 2
154  CALL dsytrf( 'U', -1, a, 1, ip, w, 1, info )
155  CALL chkxer( 'DSYTRF', infot, nout, lerr, ok )
156  infot = 4
157  CALL dsytrf( 'U', 2, a, 1, ip, w, 4, info )
158  CALL chkxer( 'DSYTRF', infot, nout, lerr, ok )
159  infot = 7
160  CALL dsytrf( 'U', 0, a, 1, ip, w, 0, info )
161  CALL chkxer( 'DSYTRF', infot, nout, lerr, ok )
162  infot = 7
163  CALL dsytrf( 'U', 0, a, 1, ip, w, -2, info )
164  CALL chkxer( 'DSYTRF', infot, nout, lerr, ok )
165 *
166 * DSYTF2
167 *
168  srnamt = 'DSYTF2'
169  infot = 1
170  CALL dsytf2( '/', 0, a, 1, ip, info )
171  CALL chkxer( 'DSYTF2', infot, nout, lerr, ok )
172  infot = 2
173  CALL dsytf2( 'U', -1, a, 1, ip, info )
174  CALL chkxer( 'DSYTF2', infot, nout, lerr, ok )
175  infot = 4
176  CALL dsytf2( 'U', 2, a, 1, ip, info )
177  CALL chkxer( 'DSYTF2', infot, nout, lerr, ok )
178 *
179 * DSYTRI
180 *
181  srnamt = 'DSYTRI'
182  infot = 1
183  CALL dsytri( '/', 0, a, 1, ip, w, info )
184  CALL chkxer( 'DSYTRI', infot, nout, lerr, ok )
185  infot = 2
186  CALL dsytri( 'U', -1, a, 1, ip, w, info )
187  CALL chkxer( 'DSYTRI', infot, nout, lerr, ok )
188  infot = 4
189  CALL dsytri( 'U', 2, a, 1, ip, w, info )
190  CALL chkxer( 'DSYTRI', infot, nout, lerr, ok )
191 *
192 * DSYTRI2
193 *
194  srnamt = 'DSYTRI2'
195  infot = 1
196  CALL dsytri2( '/', 0, a, 1, ip, w, iw, info )
197  CALL chkxer( 'DSYTRI2', infot, nout, lerr, ok )
198  infot = 2
199  CALL dsytri2( 'U', -1, a, 1, ip, w, iw, info )
200  CALL chkxer( 'DSYTRI2', infot, nout, lerr, ok )
201  infot = 4
202  CALL dsytri2( 'U', 2, a, 1, ip, w, iw, info )
203  CALL chkxer( 'DSYTRI2', infot, nout, lerr, ok )
204 *
205 * DSYTRI2X
206 *
207  srnamt = 'DSYTRI2X'
208  infot = 1
209  CALL dsytri2x( '/', 0, a, 1, ip, w, 1, info )
210  CALL chkxer( 'DSYTRI2X', infot, nout, lerr, ok )
211  infot = 2
212  CALL dsytri2x( 'U', -1, a, 1, ip, w, 1, info )
213  CALL chkxer( 'DSYTRI2X', infot, nout, lerr, ok )
214  infot = 4
215  CALL dsytri2x( 'U', 2, a, 1, ip, w, 1, info )
216  CALL chkxer( 'DSYTRI2X', infot, nout, lerr, ok )
217 *
218 * DSYTRS
219 *
220  srnamt = 'DSYTRS'
221  infot = 1
222  CALL dsytrs( '/', 0, 0, a, 1, ip, b, 1, info )
223  CALL chkxer( 'DSYTRS', infot, nout, lerr, ok )
224  infot = 2
225  CALL dsytrs( 'U', -1, 0, a, 1, ip, b, 1, info )
226  CALL chkxer( 'DSYTRS', infot, nout, lerr, ok )
227  infot = 3
228  CALL dsytrs( 'U', 0, -1, a, 1, ip, b, 1, info )
229  CALL chkxer( 'DSYTRS', infot, nout, lerr, ok )
230  infot = 5
231  CALL dsytrs( 'U', 2, 1, a, 1, ip, b, 2, info )
232  CALL chkxer( 'DSYTRS', infot, nout, lerr, ok )
233  infot = 8
234  CALL dsytrs( 'U', 2, 1, a, 2, ip, b, 1, info )
235  CALL chkxer( 'DSYTRS', infot, nout, lerr, ok )
236 *
237 * DSYRFS
238 *
239  srnamt = 'DSYRFS'
240  infot = 1
241  CALL dsyrfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
242  $ iw, info )
243  CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
244  infot = 2
245  CALL dsyrfs( 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
246  $ w, iw, info )
247  CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
248  infot = 3
249  CALL dsyrfs( 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
250  $ w, iw, info )
251  CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
252  infot = 5
253  CALL dsyrfs( 'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
254  $ iw, info )
255  CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
256  infot = 7
257  CALL dsyrfs( 'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
258  $ iw, info )
259  CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
260  infot = 10
261  CALL dsyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
262  $ iw, info )
263  CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
264  infot = 12
265  CALL dsyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
266  $ iw, info )
267  CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
268 *
269 * DSYRFSX
270 *
271  n_err_bnds = 3
272  nparams = 0
273  srnamt = 'DSYRFSX'
274  infot = 1
275  CALL dsyrfsx( '/', eq, 0, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
276  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
277  $ params, w, iw, info )
278  CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
279  infot = 2
280  CALL dsyrfsx( 'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
281  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
282  $ params, w, iw, info )
283  CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
284  eq = 'N'
285  infot = 3
286  CALL dsyrfsx( 'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
287  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
288  $ params, w, iw, info )
289  CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
290  infot = 4
291  CALL dsyrfsx( 'U', eq, 0, -1, a, 1, af, 1, ip, s, b, 1, x, 1,
292  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
293  $ params, w, iw, info )
294  CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
295  infot = 6
296  CALL dsyrfsx( 'U', eq, 2, 1, a, 1, af, 2, ip, s, b, 2, x, 2,
297  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
298  $ params, w, iw, info )
299  CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
300  infot = 8
301  CALL dsyrfsx( 'U', eq, 2, 1, a, 2, af, 1, ip, s, b, 2, x, 2,
302  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
303  $ params, w, iw, info )
304  CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
305  infot = 12
306  CALL dsyrfsx( 'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 1, x, 2,
307  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
308  $ params, w, iw, info )
309  CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
310  infot = 14
311  CALL dsyrfsx( 'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 2, x, 1,
312  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
313  $ params, w, iw, info )
314  CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
315 *
316 * DSYCON
317 *
318  srnamt = 'DSYCON'
319  infot = 1
320  CALL dsycon( '/', 0, a, 1, ip, anrm, rcond, w, iw, info )
321  CALL chkxer( 'DSYCON', infot, nout, lerr, ok )
322  infot = 2
323  CALL dsycon( 'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
324  CALL chkxer( 'DSYCON', infot, nout, lerr, ok )
325  infot = 4
326  CALL dsycon( 'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
327  CALL chkxer( 'DSYCON', infot, nout, lerr, ok )
328  infot = 6
329  CALL dsycon( 'U', 1, a, 1, ip, -1.0d0, rcond, w, iw, info )
330  CALL chkxer( 'DSYCON', infot, nout, lerr, ok )
331 *
332  ELSE IF( lsamen( 2, c2, 'SR' ) ) THEN
333 *
334 * Test error exits of the routines that use factorization
335 * of a symmetric indefinite matrix with rook
336 * (bounded Bunch-Kaufman) pivoting.
337 *
338 * DSYTRF_ROOK
339 *
340  srnamt = 'DSYTRF_ROOK'
341  infot = 1
342  CALL dsytrf_rook( '/', 0, a, 1, ip, w, 1, info )
343  CALL chkxer( 'DSYTRF_ROOK', infot, nout, lerr, ok )
344  infot = 2
345  CALL dsytrf_rook( 'U', -1, a, 1, ip, w, 1, info )
346  CALL chkxer( 'DSYTRF_ROOK', infot, nout, lerr, ok )
347  infot = 4
348  CALL dsytrf_rook( 'U', 2, a, 1, ip, w, 4, info )
349  CALL chkxer( 'DSYTRF_ROOK', infot, nout, lerr, ok )
350  infot = 7
351  CALL dsytrf_rook( 'U', 0, a, 1, ip, w, 0, info )
352  CALL chkxer( 'DSYTRF_ROOK', infot, nout, lerr, ok )
353  infot = 7
354  CALL dsytrf_rook( 'U', 0, a, 1, ip, w, -2, info )
355  CALL chkxer( 'DSYTRF_ROOK', infot, nout, lerr, ok )
356 *
357 * DSYTF2_ROOK
358 *
359  srnamt = 'DSYTF2_ROOK'
360  infot = 1
361  CALL dsytf2_rook( '/', 0, a, 1, ip, info )
362  CALL chkxer( 'DSYTF2_ROOK', infot, nout, lerr, ok )
363  infot = 2
364  CALL dsytf2_rook( 'U', -1, a, 1, ip, info )
365  CALL chkxer( 'DSYTF2_ROOK', infot, nout, lerr, ok )
366  infot = 4
367  CALL dsytf2_rook( 'U', 2, a, 1, ip, info )
368  CALL chkxer( 'DSYTF2_ROOK', infot, nout, lerr, ok )
369 *
370 * DSYTRI_ROOK
371 *
372  srnamt = 'DSYTRI_ROOK'
373  infot = 1
374  CALL dsytri_rook( '/', 0, a, 1, ip, w, info )
375  CALL chkxer( 'DSYTRI_ROOK', infot, nout, lerr, ok )
376  infot = 2
377  CALL dsytri_rook( 'U', -1, a, 1, ip, w, info )
378  CALL chkxer( 'DSYTRI_ROOK', infot, nout, lerr, ok )
379  infot = 4
380  CALL dsytri_rook( 'U', 2, a, 1, ip, w, info )
381  CALL chkxer( 'DSYTRI_ROOK', infot, nout, lerr, ok )
382 *
383 * DSYTRS_ROOK
384 *
385  srnamt = 'DSYTRS_ROOK'
386  infot = 1
387  CALL dsytrs_rook( '/', 0, 0, a, 1, ip, b, 1, info )
388  CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
389  infot = 2
390  CALL dsytrs_rook( 'U', -1, 0, a, 1, ip, b, 1, info )
391  CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
392  infot = 3
393  CALL dsytrs_rook( 'U', 0, -1, a, 1, ip, b, 1, info )
394  CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
395  infot = 5
396  CALL dsytrs_rook( 'U', 2, 1, a, 1, ip, b, 2, info )
397  CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
398  infot = 8
399  CALL dsytrs_rook( 'U', 2, 1, a, 2, ip, b, 1, info )
400  CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
401 *
402 * DSYCON_ROOK
403 *
404  srnamt = 'DSYCON_ROOK'
405  infot = 1
406  CALL dsycon_rook( '/', 0, a, 1, ip, anrm, rcond, w, iw, info )
407  CALL chkxer( 'DSYCON_ROOK', infot, nout, lerr, ok )
408  infot = 2
409  CALL dsycon_rook( 'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
410  CALL chkxer( 'DSYCON_ROOK', infot, nout, lerr, ok )
411  infot = 4
412  CALL dsycon_rook( 'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
413  CALL chkxer( 'DSYCON_ROOK', infot, nout, lerr, ok )
414  infot = 6
415  CALL dsycon_rook( 'U', 1, a, 1, ip, -1.0d0, rcond, w, iw, info)
416  CALL chkxer( 'DSYCON_ROOK', infot, nout, lerr, ok )
417 *
418  ELSE IF( lsamen( 2, c2, 'SK' ) ) THEN
419 *
420 * Test error exits of the routines that use factorization
421 * of a symmetric indefinite matrix with rook
422 * (bounded Bunch-Kaufman) pivoting with the new storage
423 * format for factors L ( or U) and D.
424 *
425 * L (or U) is stored in A, diagonal of D is stored on the
426 * diagonal of A, subdiagonal of D is stored in a separate array E.
427 *
428 * DSYTRF_RK
429 *
430  srnamt = 'DSYTRF_RK'
431  infot = 1
432  CALL dsytrf_rk( '/', 0, a, 1, e, ip, w, 1, info )
433  CALL chkxer( 'DSYTRF_RK', infot, nout, lerr, ok )
434  infot = 2
435  CALL dsytrf_rk( 'U', -1, a, 1, e, ip, w, 1, info )
436  CALL chkxer( 'DSYTRF_RK', infot, nout, lerr, ok )
437  infot = 4
438  CALL dsytrf_rk( 'U', 2, a, 1, e, ip, w, 1, info )
439  CALL chkxer( 'DSYTRF_RK', infot, nout, lerr, ok )
440  infot = 8
441  CALL dsytrf_rk( 'U', 0, a, 1, e, ip, w, 0, info )
442  CALL chkxer( 'DSYTRF_RK', infot, nout, lerr, ok )
443  infot = 8
444  CALL dsytrf_rk( 'U', 0, a, 1, e, ip, w, -2, info )
445  CALL chkxer( 'DSYTRF_RK', infot, nout, lerr, ok )
446 *
447 * DSYTF2_RK
448 *
449  srnamt = 'DSYTF2_RK'
450  infot = 1
451  CALL dsytf2_rk( '/', 0, a, 1, e, ip, info )
452  CALL chkxer( 'DSYTF2_RK', infot, nout, lerr, ok )
453  infot = 2
454  CALL dsytf2_rk( 'U', -1, a, 1, e, ip, info )
455  CALL chkxer( 'DSYTF2_RK', infot, nout, lerr, ok )
456  infot = 4
457  CALL dsytf2_rk( 'U', 2, a, 1, e, ip, info )
458  CALL chkxer( 'DSYTF2_RK', infot, nout, lerr, ok )
459 *
460 * DSYTRI_3
461 *
462  srnamt = 'DSYTRI_3'
463  infot = 1
464  CALL dsytri_3( '/', 0, a, 1, e, ip, w, 1, info )
465  CALL chkxer( 'DSYTRI_3', infot, nout, lerr, ok )
466  infot = 2
467  CALL dsytri_3( 'U', -1, a, 1, e, ip, w, 1, info )
468  CALL chkxer( 'DSYTRI_3', infot, nout, lerr, ok )
469  infot = 4
470  CALL dsytri_3( 'U', 2, a, 1, e, ip, w, 1, info )
471  CALL chkxer( 'DSYTRI_3', infot, nout, lerr, ok )
472  infot = 8
473  CALL dsytri_3( 'U', 0, a, 1, e, ip, w, 0, info )
474  CALL chkxer( 'DSYTRI_3', infot, nout, lerr, ok )
475  infot = 8
476  CALL dsytri_3( 'U', 0, a, 1, e, ip, w, -2, info )
477  CALL chkxer( 'DSYTRI_3', infot, nout, lerr, ok )
478 *
479 * DSYTRI_3X
480 *
481  srnamt = 'DSYTRI_3X'
482  infot = 1
483  CALL dsytri_3x( '/', 0, a, 1, e, ip, w, 1, info )
484  CALL chkxer( 'DSYTRI_3X', infot, nout, lerr, ok )
485  infot = 2
486  CALL dsytri_3x( 'U', -1, a, 1, e, ip, w, 1, info )
487  CALL chkxer( 'DSYTRI_3X', infot, nout, lerr, ok )
488  infot = 4
489  CALL dsytri_3x( 'U', 2, a, 1, e, ip, w, 1, info )
490  CALL chkxer( 'DSYTRI_3X', infot, nout, lerr, ok )
491 *
492 * DSYTRS_3
493 *
494  srnamt = 'DSYTRS_3'
495  infot = 1
496  CALL dsytrs_3( '/', 0, 0, a, 1, e, ip, b, 1, info )
497  CALL chkxer( 'DSYTRS_3', infot, nout, lerr, ok )
498  infot = 2
499  CALL dsytrs_3( 'U', -1, 0, a, 1, e, ip, b, 1, info )
500  CALL chkxer( 'DSYTRS_3', infot, nout, lerr, ok )
501  infot = 3
502  CALL dsytrs_3( 'U', 0, -1, a, 1, e, ip, b, 1, info )
503  CALL chkxer( 'DSYTRS_3', infot, nout, lerr, ok )
504  infot = 5
505  CALL dsytrs_3( 'U', 2, 1, a, 1, e, ip, b, 2, info )
506  CALL chkxer( 'DSYTRS_3', infot, nout, lerr, ok )
507  infot = 9
508  CALL dsytrs_3( 'U', 2, 1, a, 2, e, ip, b, 1, info )
509  CALL chkxer( 'DSYTRS_3', infot, nout, lerr, ok )
510 *
511 * DSYCON_3
512 *
513  srnamt = 'DSYCON_3'
514  infot = 1
515  CALL dsycon_3( '/', 0, a, 1, e, ip, anrm, rcond, w, iw,
516  $ info )
517  CALL chkxer( 'DSYCON_3', infot, nout, lerr, ok )
518  infot = 2
519  CALL dsycon_3( 'U', -1, a, 1, e, ip, anrm, rcond, w, iw,
520  $ info )
521  CALL chkxer( 'DSYCON_3', infot, nout, lerr, ok )
522  infot = 4
523  CALL dsycon_3( 'U', 2, a, 1, e, ip, anrm, rcond, w, iw,
524  $ info )
525  CALL chkxer( 'DSYCON_3', infot, nout, lerr, ok )
526  infot = 7
527  CALL dsycon_3( 'U', 1, a, 1, e, ip, -1.0d0, rcond, w, iw,
528  $ info)
529  CALL chkxer( 'DSYCON_3', infot, nout, lerr, ok )
530 *
531  ELSE IF( lsamen( 2, c2, 'SP' ) ) THEN
532 *
533 * Test error exits of the routines that use factorization
534 * of a symmetric indefinite packed matrix with patrial
535 * (Bunch-Kaufman) pivoting.
536 *
537 * DSPTRF
538 *
539  srnamt = 'DSPTRF'
540  infot = 1
541  CALL dsptrf( '/', 0, a, ip, info )
542  CALL chkxer( 'DSPTRF', infot, nout, lerr, ok )
543  infot = 2
544  CALL dsptrf( 'U', -1, a, ip, info )
545  CALL chkxer( 'DSPTRF', infot, nout, lerr, ok )
546 *
547 * DSPTRI
548 *
549  srnamt = 'DSPTRI'
550  infot = 1
551  CALL dsptri( '/', 0, a, ip, w, info )
552  CALL chkxer( 'DSPTRI', infot, nout, lerr, ok )
553  infot = 2
554  CALL dsptri( 'U', -1, a, ip, w, info )
555  CALL chkxer( 'DSPTRI', infot, nout, lerr, ok )
556 *
557 * DSPTRS
558 *
559  srnamt = 'DSPTRS'
560  infot = 1
561  CALL dsptrs( '/', 0, 0, a, ip, b, 1, info )
562  CALL chkxer( 'DSPTRS', infot, nout, lerr, ok )
563  infot = 2
564  CALL dsptrs( 'U', -1, 0, a, ip, b, 1, info )
565  CALL chkxer( 'DSPTRS', infot, nout, lerr, ok )
566  infot = 3
567  CALL dsptrs( 'U', 0, -1, a, ip, b, 1, info )
568  CALL chkxer( 'DSPTRS', infot, nout, lerr, ok )
569  infot = 7
570  CALL dsptrs( 'U', 2, 1, a, ip, b, 1, info )
571  CALL chkxer( 'DSPTRS', infot, nout, lerr, ok )
572 *
573 * DSPRFS
574 *
575  srnamt = 'DSPRFS'
576  infot = 1
577  CALL dsprfs( '/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
578  $ info )
579  CALL chkxer( 'DSPRFS', infot, nout, lerr, ok )
580  infot = 2
581  CALL dsprfs( 'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
582  $ info )
583  CALL chkxer( 'DSPRFS', infot, nout, lerr, ok )
584  infot = 3
585  CALL dsprfs( 'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
586  $ info )
587  CALL chkxer( 'DSPRFS', infot, nout, lerr, ok )
588  infot = 8
589  CALL dsprfs( 'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, iw,
590  $ info )
591  CALL chkxer( 'DSPRFS', infot, nout, lerr, ok )
592  infot = 10
593  CALL dsprfs( 'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, iw,
594  $ info )
595  CALL chkxer( 'DSPRFS', infot, nout, lerr, ok )
596 *
597 * DSPCON
598 *
599  srnamt = 'DSPCON'
600  infot = 1
601  CALL dspcon( '/', 0, a, ip, anrm, rcond, w, iw, info )
602  CALL chkxer( 'DSPCON', infot, nout, lerr, ok )
603  infot = 2
604  CALL dspcon( 'U', -1, a, ip, anrm, rcond, w, iw, info )
605  CALL chkxer( 'DSPCON', infot, nout, lerr, ok )
606  infot = 5
607  CALL dspcon( 'U', 1, a, ip, -1.0d0, rcond, w, iw, info )
608  CALL chkxer( 'DSPCON', infot, nout, lerr, ok )
609  END IF
610 *
611 * Print a summary line.
612 *
613  CALL alaesm( path, ok, nout )
614 *
615  RETURN
616 *
617 * End of DERRSY
618 *
619  END
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
dsytri
subroutine dsytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
DSYTRI
Definition: dsytri.f:116
dsytrf
subroutine dsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF
Definition: dsytrf.f:184
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:196
dsptrs
subroutine dsptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
DSPTRS
Definition: dsptrs.f:117
dsytri2x
subroutine dsytri2x(UPLO, N, A, LDA, IPIV, WORK, NB, INFO)
DSYTRI2X
Definition: dsytri2x.f:122
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:404
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
dsycon_rook
subroutine dsycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON_ROOK
Definition: dsycon_rook.f:146
dsytrf_rook
subroutine dsytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF_ROOK
Definition: dsytrf_rook.f:210
dsytrs_rook
subroutine dsytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS_ROOK
Definition: dsytrs_rook.f:138
dsprfs
subroutine dsprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DSPRFS
Definition: dsprfs.f:181
dsycon_3
subroutine dsycon_3(UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON_3
Definition: dsycon_3.f:173
dsptrf
subroutine dsptrf(UPLO, N, AP, IPIV, INFO)
DSPTRF
Definition: dsptrf.f:161
dsptri
subroutine dsptri(UPLO, N, AP, IPIV, WORK, INFO)
DSPTRI
Definition: dsptri.f:111
dsyrfs
subroutine dsyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DSYRFS
Definition: dsyrfs.f:193
derrsy
subroutine derrsy(PATH, NUNIT)
DERRSY
Definition: derrsy.f:57
dsytri_rook
subroutine dsytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
DSYTRI_ROOK
Definition: dsytri_rook.f:131
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:243
dsytri2
subroutine dsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRI2
Definition: dsytri2.f:129
dspcon
subroutine dspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSPCON
Definition: dspcon.f:127
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:261
dsytrs_3
subroutine dsytrs_3(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO)
DSYTRS_3
Definition: dsytrs_3.f:167
dsycon
subroutine dsycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON
Definition: dsycon.f:132
dsytrs
subroutine dsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS
Definition: dsytrs.f:122
dsytri_3
subroutine dsytri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
DSYTRI_3
Definition: dsytri_3.f:172
dsytri_3x
subroutine dsytri_3x(UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO)
DSYTRI_3X
Definition: dsytri_3x.f:161
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:196