LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ derrsy()

subroutine derrsy ( character*3  path,
integer  nunit 
)

DERRSYX

Purpose:
 DERRSY tests the error exits for the DOUBLE PRECISION routines
 for symmetric indefinite matrices.

 Note that this file is used only when the XBLAS are available,
 otherwise derrsy.f defines this subroutine.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 57 of file derrsyx.f.

58*
59* -- LAPACK test routine --
60* -- LAPACK is a software package provided by Univ. of Tennessee, --
61* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
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 EQ
76 CHARACTER*2 C2
77 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
78 DOUBLE PRECISION ANRM, RCOND, BERR
79* ..
80* .. Local Arrays ..
81 INTEGER IP( NMAX ), IW( NMAX )
82 DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
83 $ E( NMAX ), R1( NMAX ), R2( NMAX ), W( 3*NMAX ),
84 $ X( NMAX ), S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
85 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
86* ..
87* .. External Functions ..
88 LOGICAL LSAMEN
89 EXTERNAL lsamen
90* ..
91* .. External Subroutines ..
92 EXTERNAL alaesm, chkxer, dspcon, dsprfs, dsptrf, dsptri,
98* ..
99* .. Scalars in Common ..
100 LOGICAL LERR, OK
101 CHARACTER*32 SRNAMT
102 INTEGER INFOT, NOUT
103* ..
104* .. Common blocks ..
105 COMMON / infoc / infot, nout, ok, lerr
106 COMMON / srnamc / srnamt
107* ..
108* .. Intrinsic Functions ..
109 INTRINSIC dble
110* ..
111* .. Executable Statements ..
112*
113 nout = nunit
114 WRITE( nout, fmt = * )
115 c2 = path( 2: 3 )
116*
117* Set the variables to innocuous values.
118*
119 DO 20 j = 1, nmax
120 DO 10 i = 1, nmax
121 a( i, j ) = 1.d0 / dble( i+j )
122 af( i, j ) = 1.d0 / dble( i+j )
123 10 CONTINUE
124 b( j ) = 0.d0
125 e( j ) = 0.d0
126 r1( j ) = 0.d0
127 r2( j ) = 0.d0
128 w( j ) = 0.d0
129 x( j ) = 0.d0
130 s( j ) = 0.d0
131 ip( j ) = j
132 iw( j ) = j
133 20 CONTINUE
134 anrm = 1.0d0
135 rcond = 1.0d0
136 ok = .true.
137*
138 IF( lsamen( 2, c2, 'SY' ) ) THEN
139*
140* Test error exits of the routines that use factorization
141* of a symmetric indefinite matrix with partial
142* (Bunch-Kaufman) pivoting.
143*
144* DSYTRF
145*
146 srnamt = 'DSYTRF'
147 infot = 1
148 CALL dsytrf( '/', 0, a, 1, ip, w, 1, info )
149 CALL chkxer( 'DSYTRF', infot, nout, lerr, ok )
150 infot = 2
151 CALL dsytrf( 'U', -1, a, 1, ip, w, 1, info )
152 CALL chkxer( 'DSYTRF', infot, nout, lerr, ok )
153 infot = 4
154 CALL dsytrf( 'U', 2, a, 1, ip, w, 4, info )
155 CALL chkxer( 'DSYTRF', infot, nout, lerr, ok )
156 infot = 7
157 CALL dsytrf( 'U', 0, a, 1, ip, w, 0, info )
158 CALL chkxer( 'DSYTRF', infot, nout, lerr, ok )
159 infot = 7
160 CALL dsytrf( 'U', 0, a, 1, ip, w, -2, info )
161 CALL chkxer( 'DSYTRF', infot, nout, lerr, ok )
162*
163* DSYTF2
164*
165 srnamt = 'DSYTF2'
166 infot = 1
167 CALL dsytf2( '/', 0, a, 1, ip, info )
168 CALL chkxer( 'DSYTF2', infot, nout, lerr, ok )
169 infot = 2
170 CALL dsytf2( 'U', -1, a, 1, ip, info )
171 CALL chkxer( 'DSYTF2', infot, nout, lerr, ok )
172 infot = 4
173 CALL dsytf2( 'U', 2, a, 1, ip, info )
174 CALL chkxer( 'DSYTF2', infot, nout, lerr, ok )
175*
176* DSYTRI
177*
178 srnamt = 'DSYTRI'
179 infot = 1
180 CALL dsytri( '/', 0, a, 1, ip, w, info )
181 CALL chkxer( 'DSYTRI', infot, nout, lerr, ok )
182 infot = 2
183 CALL dsytri( 'U', -1, a, 1, ip, w, info )
184 CALL chkxer( 'DSYTRI', infot, nout, lerr, ok )
185 infot = 4
186 CALL dsytri( 'U', 2, a, 1, ip, w, info )
187 CALL chkxer( 'DSYTRI', infot, nout, lerr, ok )
188*
189* DSYTRI2
190*
191 srnamt = 'DSYTRI2'
192 infot = 1
193 CALL dsytri2( '/', 0, a, 1, ip, w, iw, info )
194 CALL chkxer( 'DSYTRI2', infot, nout, lerr, ok )
195 infot = 2
196 CALL dsytri2( 'U', -1, a, 1, ip, w, iw, info )
197 CALL chkxer( 'DSYTRI2', infot, nout, lerr, ok )
198 infot = 4
199 CALL dsytri2( 'U', 2, a, 1, ip, w, iw, info )
200 CALL chkxer( 'DSYTRI2', infot, nout, lerr, ok )
201*
202* DSYTRI2X
203*
204 srnamt = 'DSYTRI2X'
205 infot = 1
206 CALL dsytri2x( '/', 0, a, 1, ip, w, 1, info )
207 CALL chkxer( 'DSYTRI2X', infot, nout, lerr, ok )
208 infot = 2
209 CALL dsytri2x( 'U', -1, a, 1, ip, w, 1, info )
210 CALL chkxer( 'DSYTRI2X', infot, nout, lerr, ok )
211 infot = 4
212 CALL dsytri2x( 'U', 2, a, 1, ip, w, 1, info )
213 CALL chkxer( 'DSYTRI2X', infot, nout, lerr, ok )
214*
215* DSYTRS
216*
217 srnamt = 'DSYTRS'
218 infot = 1
219 CALL dsytrs( '/', 0, 0, a, 1, ip, b, 1, info )
220 CALL chkxer( 'DSYTRS', infot, nout, lerr, ok )
221 infot = 2
222 CALL dsytrs( 'U', -1, 0, a, 1, ip, b, 1, info )
223 CALL chkxer( 'DSYTRS', infot, nout, lerr, ok )
224 infot = 3
225 CALL dsytrs( 'U', 0, -1, a, 1, ip, b, 1, info )
226 CALL chkxer( 'DSYTRS', infot, nout, lerr, ok )
227 infot = 5
228 CALL dsytrs( 'U', 2, 1, a, 1, ip, b, 2, info )
229 CALL chkxer( 'DSYTRS', infot, nout, lerr, ok )
230 infot = 8
231 CALL dsytrs( 'U', 2, 1, a, 2, ip, b, 1, info )
232 CALL chkxer( 'DSYTRS', infot, nout, lerr, ok )
233*
234* DSYRFS
235*
236 srnamt = 'DSYRFS'
237 infot = 1
238 CALL dsyrfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
239 $ iw, info )
240 CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
241 infot = 2
242 CALL dsyrfs( 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
243 $ w, iw, info )
244 CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
245 infot = 3
246 CALL dsyrfs( 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
247 $ w, iw, info )
248 CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
249 infot = 5
250 CALL dsyrfs( 'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
251 $ iw, info )
252 CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
253 infot = 7
254 CALL dsyrfs( 'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
255 $ iw, info )
256 CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
257 infot = 10
258 CALL dsyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
259 $ iw, info )
260 CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
261 infot = 12
262 CALL dsyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
263 $ iw, info )
264 CALL chkxer( 'DSYRFS', infot, nout, lerr, ok )
265*
266* DSYRFSX
267*
268 n_err_bnds = 3
269 nparams = 0
270 srnamt = 'DSYRFSX'
271 infot = 1
272 CALL dsyrfsx( '/', eq, 0, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
273 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
274 $ params, w, iw, info )
275 CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
276 infot = 2
277 CALL dsyrfsx( 'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
278 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
279 $ params, w, iw, info )
280 CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
281 eq = 'N'
282 infot = 3
283 CALL dsyrfsx( 'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
284 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
285 $ params, w, iw, info )
286 CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
287 infot = 4
288 CALL dsyrfsx( 'U', eq, 0, -1, a, 1, af, 1, ip, s, b, 1, x, 1,
289 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
290 $ params, w, iw, info )
291 CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
292 infot = 6
293 CALL dsyrfsx( 'U', eq, 2, 1, a, 1, af, 2, ip, s, b, 2, x, 2,
294 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
295 $ params, w, iw, info )
296 CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
297 infot = 8
298 CALL dsyrfsx( 'U', eq, 2, 1, a, 2, af, 1, ip, s, b, 2, x, 2,
299 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
300 $ params, w, iw, info )
301 CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
302 infot = 12
303 CALL dsyrfsx( 'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 1, x, 2,
304 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
305 $ params, w, iw, info )
306 CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
307 infot = 14
308 CALL dsyrfsx( 'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 2, x, 1,
309 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
310 $ params, w, iw, info )
311 CALL chkxer( 'DSYRFSX', infot, nout, lerr, ok )
312*
313* DSYCON
314*
315 srnamt = 'DSYCON'
316 infot = 1
317 CALL dsycon( '/', 0, a, 1, ip, anrm, rcond, w, iw, info )
318 CALL chkxer( 'DSYCON', infot, nout, lerr, ok )
319 infot = 2
320 CALL dsycon( 'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
321 CALL chkxer( 'DSYCON', infot, nout, lerr, ok )
322 infot = 4
323 CALL dsycon( 'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
324 CALL chkxer( 'DSYCON', infot, nout, lerr, ok )
325 infot = 6
326 CALL dsycon( 'U', 1, a, 1, ip, -1.0d0, rcond, w, iw, info )
327 CALL chkxer( 'DSYCON', infot, nout, lerr, ok )
328*
329 ELSE IF( lsamen( 2, c2, 'SR' ) ) THEN
330*
331* Test error exits of the routines that use factorization
332* of a symmetric indefinite matrix with rook
333* (bounded Bunch-Kaufman) pivoting.
334*
335* DSYTRF_ROOK
336*
337 srnamt = 'DSYTRF_ROOK'
338 infot = 1
339 CALL dsytrf_rook( '/', 0, a, 1, ip, w, 1, info )
340 CALL chkxer( 'DSYTRF_ROOK', infot, nout, lerr, ok )
341 infot = 2
342 CALL dsytrf_rook( 'U', -1, a, 1, ip, w, 1, info )
343 CALL chkxer( 'DSYTRF_ROOK', infot, nout, lerr, ok )
344 infot = 4
345 CALL dsytrf_rook( 'U', 2, a, 1, ip, w, 4, info )
346 CALL chkxer( 'DSYTRF_ROOK', infot, nout, lerr, ok )
347 infot = 7
348 CALL dsytrf_rook( 'U', 0, a, 1, ip, w, 0, info )
349 CALL chkxer( 'DSYTRF_ROOK', infot, nout, lerr, ok )
350 infot = 7
351 CALL dsytrf_rook( 'U', 0, a, 1, ip, w, -2, info )
352 CALL chkxer( 'DSYTRF_ROOK', infot, nout, lerr, ok )
353*
354* DSYTF2_ROOK
355*
356 srnamt = 'DSYTF2_ROOK'
357 infot = 1
358 CALL dsytf2_rook( '/', 0, a, 1, ip, info )
359 CALL chkxer( 'DSYTF2_ROOK', infot, nout, lerr, ok )
360 infot = 2
361 CALL dsytf2_rook( 'U', -1, a, 1, ip, info )
362 CALL chkxer( 'DSYTF2_ROOK', infot, nout, lerr, ok )
363 infot = 4
364 CALL dsytf2_rook( 'U', 2, a, 1, ip, info )
365 CALL chkxer( 'DSYTF2_ROOK', infot, nout, lerr, ok )
366*
367* DSYTRI_ROOK
368*
369 srnamt = 'DSYTRI_ROOK'
370 infot = 1
371 CALL dsytri_rook( '/', 0, a, 1, ip, w, info )
372 CALL chkxer( 'DSYTRI_ROOK', infot, nout, lerr, ok )
373 infot = 2
374 CALL dsytri_rook( 'U', -1, a, 1, ip, w, info )
375 CALL chkxer( 'DSYTRI_ROOK', infot, nout, lerr, ok )
376 infot = 4
377 CALL dsytri_rook( 'U', 2, a, 1, ip, w, info )
378 CALL chkxer( 'DSYTRI_ROOK', infot, nout, lerr, ok )
379*
380* DSYTRS_ROOK
381*
382 srnamt = 'DSYTRS_ROOK'
383 infot = 1
384 CALL dsytrs_rook( '/', 0, 0, a, 1, ip, b, 1, info )
385 CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
386 infot = 2
387 CALL dsytrs_rook( 'U', -1, 0, a, 1, ip, b, 1, info )
388 CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
389 infot = 3
390 CALL dsytrs_rook( 'U', 0, -1, a, 1, ip, b, 1, info )
391 CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
392 infot = 5
393 CALL dsytrs_rook( 'U', 2, 1, a, 1, ip, b, 2, info )
394 CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
395 infot = 8
396 CALL dsytrs_rook( 'U', 2, 1, a, 2, ip, b, 1, info )
397 CALL chkxer( 'DSYTRS_ROOK', infot, nout, lerr, ok )
398*
399* DSYCON_ROOK
400*
401 srnamt = 'DSYCON_ROOK'
402 infot = 1
403 CALL dsycon_rook( '/', 0, a, 1, ip, anrm, rcond, w, iw, info )
404 CALL chkxer( 'DSYCON_ROOK', infot, nout, lerr, ok )
405 infot = 2
406 CALL dsycon_rook( 'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
407 CALL chkxer( 'DSYCON_ROOK', infot, nout, lerr, ok )
408 infot = 4
409 CALL dsycon_rook( 'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
410 CALL chkxer( 'DSYCON_ROOK', infot, nout, lerr, ok )
411 infot = 6
412 CALL dsycon_rook( 'U', 1, a, 1, ip, -1.0d0, rcond, w, iw, info)
413 CALL chkxer( 'DSYCON_ROOK', infot, nout, lerr, ok )
414*
415 ELSE IF( lsamen( 2, c2, 'SK' ) ) THEN
416*
417* Test error exits of the routines that use factorization
418* of a symmetric indefinite matrix with rook
419* (bounded Bunch-Kaufman) pivoting with the new storage
420* format for factors L ( or U) and D.
421*
422* L (or U) is stored in A, diagonal of D is stored on the
423* diagonal of A, subdiagonal of D is stored in a separate array E.
424*
425* DSYTRF_RK
426*
427 srnamt = 'DSYTRF_RK'
428 infot = 1
429 CALL dsytrf_rk( '/', 0, a, 1, e, ip, w, 1, info )
430 CALL chkxer( 'DSYTRF_RK', infot, nout, lerr, ok )
431 infot = 2
432 CALL dsytrf_rk( 'U', -1, a, 1, e, ip, w, 1, info )
433 CALL chkxer( 'DSYTRF_RK', infot, nout, lerr, ok )
434 infot = 4
435 CALL dsytrf_rk( 'U', 2, a, 1, e, ip, w, 1, info )
436 CALL chkxer( 'DSYTRF_RK', infot, nout, lerr, ok )
437 infot = 8
438 CALL dsytrf_rk( 'U', 0, a, 1, e, ip, w, 0, info )
439 CALL chkxer( 'DSYTRF_RK', infot, nout, lerr, ok )
440 infot = 8
441 CALL dsytrf_rk( 'U', 0, a, 1, e, ip, w, -2, info )
442 CALL chkxer( 'DSYTRF_RK', infot, nout, lerr, ok )
443*
444* DSYTF2_RK
445*
446 srnamt = 'DSYTF2_RK'
447 infot = 1
448 CALL dsytf2_rk( '/', 0, a, 1, e, ip, info )
449 CALL chkxer( 'DSYTF2_RK', infot, nout, lerr, ok )
450 infot = 2
451 CALL dsytf2_rk( 'U', -1, a, 1, e, ip, info )
452 CALL chkxer( 'DSYTF2_RK', infot, nout, lerr, ok )
453 infot = 4
454 CALL dsytf2_rk( 'U', 2, a, 1, e, ip, info )
455 CALL chkxer( 'DSYTF2_RK', infot, nout, lerr, ok )
456*
457* DSYTRI_3
458*
459 srnamt = 'DSYTRI_3'
460 infot = 1
461 CALL dsytri_3( '/', 0, a, 1, e, ip, w, 1, info )
462 CALL chkxer( 'DSYTRI_3', infot, nout, lerr, ok )
463 infot = 2
464 CALL dsytri_3( 'U', -1, a, 1, e, ip, w, 1, info )
465 CALL chkxer( 'DSYTRI_3', infot, nout, lerr, ok )
466 infot = 4
467 CALL dsytri_3( 'U', 2, a, 1, e, ip, w, 1, info )
468 CALL chkxer( 'DSYTRI_3', infot, nout, lerr, ok )
469 infot = 8
470 CALL dsytri_3( 'U', 0, a, 1, e, ip, w, 0, info )
471 CALL chkxer( 'DSYTRI_3', infot, nout, lerr, ok )
472 infot = 8
473 CALL dsytri_3( 'U', 0, a, 1, e, ip, w, -2, info )
474 CALL chkxer( 'DSYTRI_3', infot, nout, lerr, ok )
475*
476* DSYTRI_3X
477*
478 srnamt = 'DSYTRI_3X'
479 infot = 1
480 CALL dsytri_3x( '/', 0, a, 1, e, ip, w, 1, info )
481 CALL chkxer( 'DSYTRI_3X', infot, nout, lerr, ok )
482 infot = 2
483 CALL dsytri_3x( 'U', -1, a, 1, e, ip, w, 1, info )
484 CALL chkxer( 'DSYTRI_3X', infot, nout, lerr, ok )
485 infot = 4
486 CALL dsytri_3x( 'U', 2, a, 1, e, ip, w, 1, info )
487 CALL chkxer( 'DSYTRI_3X', infot, nout, lerr, ok )
488*
489* DSYTRS_3
490*
491 srnamt = 'DSYTRS_3'
492 infot = 1
493 CALL dsytrs_3( '/', 0, 0, a, 1, e, ip, b, 1, info )
494 CALL chkxer( 'DSYTRS_3', infot, nout, lerr, ok )
495 infot = 2
496 CALL dsytrs_3( 'U', -1, 0, a, 1, e, ip, b, 1, info )
497 CALL chkxer( 'DSYTRS_3', infot, nout, lerr, ok )
498 infot = 3
499 CALL dsytrs_3( 'U', 0, -1, a, 1, e, ip, b, 1, info )
500 CALL chkxer( 'DSYTRS_3', infot, nout, lerr, ok )
501 infot = 5
502 CALL dsytrs_3( 'U', 2, 1, a, 1, e, ip, b, 2, info )
503 CALL chkxer( 'DSYTRS_3', infot, nout, lerr, ok )
504 infot = 9
505 CALL dsytrs_3( 'U', 2, 1, a, 2, e, ip, b, 1, info )
506 CALL chkxer( 'DSYTRS_3', infot, nout, lerr, ok )
507*
508* DSYCON_3
509*
510 srnamt = 'DSYCON_3'
511 infot = 1
512 CALL dsycon_3( '/', 0, a, 1, e, ip, anrm, rcond, w, iw,
513 $ info )
514 CALL chkxer( 'DSYCON_3', infot, nout, lerr, ok )
515 infot = 2
516 CALL dsycon_3( 'U', -1, a, 1, e, ip, anrm, rcond, w, iw,
517 $ info )
518 CALL chkxer( 'DSYCON_3', infot, nout, lerr, ok )
519 infot = 4
520 CALL dsycon_3( 'U', 2, a, 1, e, ip, anrm, rcond, w, iw,
521 $ info )
522 CALL chkxer( 'DSYCON_3', infot, nout, lerr, ok )
523 infot = 7
524 CALL dsycon_3( 'U', 1, a, 1, e, ip, -1.0d0, rcond, w, iw,
525 $ info)
526 CALL chkxer( 'DSYCON_3', 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 partial
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 DERRSYX
615*
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
subroutine dsycon_3(uplo, n, a, lda, e, ipiv, anorm, rcond, work, iwork, info)
DSYCON_3
Definition dsycon_3.f:171
subroutine dsycon_rook(uplo, n, a, lda, ipiv, anorm, rcond, work, iwork, info)
DSYCON_ROOK
subroutine dsycon(uplo, n, a, lda, ipiv, anorm, rcond, work, iwork, info)
DSYCON
Definition dsycon.f:130
subroutine dsyrfs(uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
DSYRFS
Definition dsyrfs.f:191
subroutine dsyrfsx(uplo, equed, n, nrhs, a, lda, af, ldaf, ipiv, s, b, ldb, x, ldx, rcond, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, iwork, info)
DSYRFSX
Definition dsyrfsx.f:402
subroutine dsytf2_rk(uplo, n, a, lda, e, ipiv, info)
DSYTF2_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Ka...
Definition dsytf2_rk.f:241
subroutine dsytf2_rook(uplo, n, a, lda, ipiv, info)
DSYTF2_ROOK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-...
subroutine dsytf2(uplo, n, a, lda, ipiv, info)
DSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
Definition dsytf2.f:194
subroutine dsytrf_rk(uplo, n, a, lda, e, ipiv, work, lwork, info)
DSYTRF_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Ka...
Definition dsytrf_rk.f:259
subroutine dsytrf_rook(uplo, n, a, lda, ipiv, work, lwork, info)
DSYTRF_ROOK
subroutine dsytrf(uplo, n, a, lda, ipiv, work, lwork, info)
DSYTRF
Definition dsytrf.f:182
subroutine dsytri2(uplo, n, a, lda, ipiv, work, lwork, info)
DSYTRI2
Definition dsytri2.f:127
subroutine dsytri2x(uplo, n, a, lda, ipiv, work, nb, info)
DSYTRI2X
Definition dsytri2x.f:120
subroutine dsytri_3(uplo, n, a, lda, e, ipiv, work, lwork, info)
DSYTRI_3
Definition dsytri_3.f:170
subroutine dsytri_3x(uplo, n, a, lda, e, ipiv, work, nb, info)
DSYTRI_3X
Definition dsytri_3x.f:159
subroutine dsytri_rook(uplo, n, a, lda, ipiv, work, info)
DSYTRI_ROOK
subroutine dsytri(uplo, n, a, lda, ipiv, work, info)
DSYTRI
Definition dsytri.f:114
subroutine dsytrs_3(uplo, n, nrhs, a, lda, e, ipiv, b, ldb, info)
DSYTRS_3
Definition dsytrs_3.f:165
subroutine dsytrs_rook(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
DSYTRS_ROOK
subroutine dsytrs(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
DSYTRS
Definition dsytrs.f:120
subroutine dspcon(uplo, n, ap, ipiv, anorm, rcond, work, iwork, info)
DSPCON
Definition dspcon.f:125
subroutine dsprfs(uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
DSPRFS
Definition dsprfs.f:179
subroutine dsptrf(uplo, n, ap, ipiv, info)
DSPTRF
Definition dsptrf.f:159
subroutine dsptri(uplo, n, ap, ipiv, work, info)
DSPTRI
Definition dsptri.f:109
subroutine dsptrs(uplo, n, nrhs, ap, ipiv, b, ldb, info)
DSPTRS
Definition dsptrs.f:115
logical function lsamen(n, ca, cb)
LSAMEN
Definition lsamen.f:74
Here is the call graph for this function: