LAPACK  3.7.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 December 2016
52 *
53 *> \ingroup double_lin
54 *
55 * =====================================================================
56  SUBROUTINE derrsy( PATH, NUNIT )
57 *
58 * -- LAPACK test routine (version 3.7.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 * December 2016
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
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, '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 DERRSY
615 *
616  END
dsytrs_rook
subroutine dsytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS_ROOK
Definition: dsytrs_rook.f:138
dsytri_3x
subroutine dsytri_3x(UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO)
DSYTRI_3X
Definition: dsytri_3x.f:161
dsptri
subroutine dsptri(UPLO, N, AP, IPIV, WORK, INFO)
DSPTRI
Definition: dsptri.f:111
dsycon_3
subroutine dsycon_3(UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON_3
Definition: dsycon_3.f:173
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
dsytri2
subroutine dsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRI2
Definition: dsytri2.f:129
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
dsytri_3
subroutine dsytri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
DSYTRI_3
Definition: dsytri_3.f:172
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
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
dsytri_rook
subroutine dsytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
DSYTRI_ROOK
Definition: dsytri_rook.f:131
dsytri
subroutine dsytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
DSYTRI
Definition: dsytri.f:116
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
dsycon
subroutine dsycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON
Definition: dsycon.f:132
dsycon_rook
subroutine dsycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON_ROOK
Definition: dsycon_rook.f:146
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
dsprfs
subroutine dsprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DSPRFS
Definition: dsprfs.f:181
dspcon
subroutine dspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSPCON
Definition: dspcon.f:127
dsytrf_aa
subroutine dsytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF_AA
Definition: dsytrf_aa.f:138
dsytrs
subroutine dsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS
Definition: dsytrs.f:122
dsytrf
subroutine dsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF
Definition: dsytrf.f:184
derrsy
subroutine derrsy(PATH, NUNIT)
DERRSY
Definition: derrsy.f:57
dsytrs_3
subroutine dsytrs_3(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO)
DSYTRS_3
Definition: dsytrs_3.f:167
dsytrf_rook
subroutine dsytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF_ROOK
Definition: dsytrf_rook.f:210
dsytrs_aa
subroutine dsytrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
DSYTRS_AA
Definition: dsytrs_aa.f:131
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
dsptrs
subroutine dsptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
DSPTRS
Definition: dsptrs.f:117
dsptrf
subroutine dsptrf(UPLO, N, AP, IPIV, INFO)
DSPTRF
Definition: dsptrf.f:161
dsytri2x
subroutine dsytri2x(UPLO, N, A, LDA, IPIV, WORK, NB, INFO)
DSYTRI2X
Definition: dsytri2x.f:122