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