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