OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
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,
88 $ dsptrs, dsycon, dsycon_3, dsycon_rook, dsyrfs,
89 $ dsytf2, dsytf2_rk, dsytf2_rook, dsytrf,
90 $ dsytrf_rk, dsytrf_rook, dsytrf_aa, dsytri,
91 $ dsytri_3, dsytri_3x, dsytri_rook, dsytri2,
92 $ dsytri2x, dsytrs, dsytrs_3, dsytrs_rook,
93 $ dsytrs_aa, dsytrf_aa_2stage, dsytrs_aa_2stage
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
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
dspcon
subroutine dspcon(uplo, n, ap, ipiv, anorm, rcond, work, iwork, info)
DSPCON
Definition dspcon.f:125
dsprfs
subroutine dsprfs(uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
DSPRFS
Definition dsprfs.f:179
dsptrs
subroutine dsptrs(uplo, n, nrhs, ap, ipiv, b, ldb, info)
DSPTRS
Definition dsptrs.f:115
dsptri
subroutine dsptri(uplo, n, ap, ipiv, work, info)
DSPTRI
Definition dsptri.f:109
dsptrf
subroutine dsptrf(uplo, n, ap, ipiv, info)
DSPTRF
Definition dsptrf.f:159
dsytrf_rook
subroutine dsytrf_rook(uplo, n, a, lda, ipiv, work, lwork, info)
DSYTRF_ROOK
Definition dsytrf_rook.f:208
dsytrs_aa
subroutine dsytrs_aa(uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork, info)
DSYTRS_AA
Definition dsytrs_aa.f:131
dsycon_3
subroutine dsycon_3(uplo, n, a, lda, e, ipiv, anorm, rcond, work, iwork, info)
DSYCON_3
Definition dsycon_3.f:171
dsycon
subroutine dsycon(uplo, n, a, lda, ipiv, anorm, rcond, work, iwork, info)
DSYCON
Definition dsycon.f:130
dsytrf
subroutine dsytrf(uplo, n, a, lda, ipiv, work, lwork, info)
DSYTRF
Definition dsytrf.f:182
dsytri2
subroutine dsytri2(uplo, n, a, lda, ipiv, work, lwork, info)
DSYTRI2
Definition dsytri2.f:127
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:160
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:241
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:139
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:194
dsytrf_aa
subroutine dsytrf_aa(uplo, n, a, lda, ipiv, work, lwork, info)
DSYTRF_AA
Definition dsytrf_aa.f:132
dsycon_rook
subroutine dsycon_rook(uplo, n, a, lda, ipiv, anorm, rcond, work, iwork, info)
DSYCON_ROOK
Definition dsycon_rook.f:144
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:259
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:194
dsytri
subroutine dsytri(uplo, n, a, lda, ipiv, work, info)
DSYTRI
Definition dsytri.f:114
dsyrfs
subroutine dsyrfs(uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
DSYRFS
Definition dsyrfs.f:191
dsytri_rook
subroutine dsytri_rook(uplo, n, a, lda, ipiv, work, info)
DSYTRI_ROOK
Definition dsytri_rook.f:129
dsytri_3x
subroutine dsytri_3x(uplo, n, a, lda, e, ipiv, work, nb, info)
DSYTRI_3X
Definition dsytri_3x.f:159
dsytri2x
subroutine dsytri2x(uplo, n, a, lda, ipiv, work, nb, info)
DSYTRI2X
Definition dsytri2x.f:120
dsytrs_3
subroutine dsytrs_3(uplo, n, nrhs, a, lda, e, ipiv, b, ldb, info)
DSYTRS_3
Definition dsytrs_3.f:165
dsytrs
subroutine dsytrs(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
DSYTRS
Definition dsytrs.f:120
dsytrs_rook
subroutine dsytrs_rook(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
DSYTRS_ROOK
Definition dsytrs_rook.f:136
dsytri_3
subroutine dsytri_3(uplo, n, a, lda, e, ipiv, work, lwork, info)
DSYTRI_3
Definition dsytri_3.f:170
derrsy
subroutine derrsy(path, nunit)
DERRSY
Definition derrsy.f:55