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