59 SUBROUTINE derrsy( PATH, NUNIT )
75 parameter ( nmax = 4 )
80 INTEGER i, info, j, n_err_bnds, nparams
81 DOUBLE PRECISION anrm, rcond, berr
84 INTEGER ip( nmax ), iw( nmax )
85 DOUBLE PRECISION a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
86 $ e( nmax ), r1( nmax ), r2( nmax ), w( 3*nmax ),
87 $ x( nmax ), s( nmax ), err_bnds_n( nmax, 3 ),
88 $ err_bnds_c( nmax, 3 ), params( 1 )
108 COMMON / infoc / infot, nout, ok, lerr
109 COMMON / srnamc / srnamt
117 WRITE( nout, fmt = * )
124 a( i, j ) = 1.d0 / dble( i+j )
125 af( i, j ) = 1.d0 / dble( i+j )
141 IF(
lsamen( 2, c2,
'SY' ) )
THEN
151 CALL dsytrf(
'/', 0, a, 1, ip, w, 1, info )
152 CALL chkxer(
'DSYTRF', infot, nout, lerr, ok )
154 CALL dsytrf(
'U', -1, a, 1, ip, w, 1, info )
155 CALL chkxer(
'DSYTRF', infot, nout, lerr, ok )
157 CALL dsytrf(
'U', 2, a, 1, ip, w, 4, info )
158 CALL chkxer(
'DSYTRF', infot, nout, lerr, ok )
160 CALL dsytrf(
'U', 0, a, 1, ip, w, 0, info )
161 CALL chkxer(
'DSYTRF', infot, nout, lerr, ok )
163 CALL dsytrf(
'U', 0, a, 1, ip, w, -2, info )
164 CALL chkxer(
'DSYTRF', infot, nout, lerr, ok )
170 CALL dsytf2(
'/', 0, a, 1, ip, info )
171 CALL chkxer(
'DSYTF2', infot, nout, lerr, ok )
173 CALL dsytf2(
'U', -1, a, 1, ip, info )
174 CALL chkxer(
'DSYTF2', infot, nout, lerr, ok )
176 CALL dsytf2(
'U', 2, a, 1, ip, info )
177 CALL chkxer(
'DSYTF2', infot, nout, lerr, ok )
183 CALL dsytri(
'/', 0, a, 1, ip, w, info )
184 CALL chkxer(
'DSYTRI', infot, nout, lerr, ok )
186 CALL dsytri(
'U', -1, a, 1, ip, w, info )
187 CALL chkxer(
'DSYTRI', infot, nout, lerr, ok )
189 CALL dsytri(
'U', 2, a, 1, ip, w, info )
190 CALL chkxer(
'DSYTRI', infot, nout, lerr, ok )
196 CALL dsytri2(
'/', 0, a, 1, ip, w, iw, info )
197 CALL chkxer(
'DSYTRI2', infot, nout, lerr, ok )
199 CALL dsytri2(
'U', -1, a, 1, ip, w, iw, info )
200 CALL chkxer(
'DSYTRI2', infot, nout, lerr, ok )
202 CALL dsytri2(
'U', 2, a, 1, ip, w, iw, info )
203 CALL chkxer(
'DSYTRI2', infot, nout, lerr, ok )
209 CALL dsytri2x(
'/', 0, a, 1, ip, w, 1, info )
210 CALL chkxer(
'DSYTRI2X', infot, nout, lerr, ok )
212 CALL dsytri2x(
'U', -1, a, 1, ip, w, 1, info )
213 CALL chkxer(
'DSYTRI2X', infot, nout, lerr, ok )
215 CALL dsytri2x(
'U', 2, a, 1, ip, w, 1, info )
216 CALL chkxer(
'DSYTRI2X', infot, nout, lerr, ok )
222 CALL dsytrs(
'/', 0, 0, a, 1, ip, b, 1, info )
223 CALL chkxer(
'DSYTRS', infot, nout, lerr, ok )
225 CALL dsytrs(
'U', -1, 0, a, 1, ip, b, 1, info )
226 CALL chkxer(
'DSYTRS', infot, nout, lerr, ok )
228 CALL dsytrs(
'U', 0, -1, a, 1, ip, b, 1, info )
229 CALL chkxer(
'DSYTRS', infot, nout, lerr, ok )
231 CALL dsytrs(
'U', 2, 1, a, 1, ip, b, 2, info )
232 CALL chkxer(
'DSYTRS', infot, nout, lerr, ok )
234 CALL dsytrs(
'U', 2, 1, a, 2, ip, b, 1, info )
235 CALL chkxer(
'DSYTRS', infot, nout, lerr, ok )
241 CALL dsyrfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
243 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
245 CALL dsyrfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
247 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
249 CALL dsyrfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
251 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
253 CALL dsyrfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
255 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
257 CALL dsyrfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
259 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
261 CALL dsyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
263 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
265 CALL dsyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
267 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
275 CALL dsyrfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
276 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
277 $ params, w, iw, info )
278 CALL chkxer(
'DSYRFSX', infot, nout, lerr, ok )
280 CALL dsyrfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
281 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
282 $ params, w, iw, info )
283 CALL chkxer(
'DSYRFSX', infot, nout, lerr, ok )
286 CALL dsyrfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
287 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
288 $ params, w, iw, info )
289 CALL chkxer(
'DSYRFSX', infot, nout, lerr, ok )
291 CALL dsyrfsx(
'U', eq, 0, -1, a, 1, af, 1, ip, s, b, 1, x, 1,
292 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
293 $ params, w, iw, info )
294 CALL chkxer(
'DSYRFSX', infot, nout, lerr, ok )
296 CALL dsyrfsx(
'U', eq, 2, 1, a, 1, af, 2, ip, s, b, 2, x, 2,
297 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
298 $ params, w, iw, info )
299 CALL chkxer(
'DSYRFSX', infot, nout, lerr, ok )
301 CALL dsyrfsx(
'U', eq, 2, 1, a, 2, af, 1, ip, s, b, 2, x, 2,
302 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
303 $ params, w, iw, info )
304 CALL chkxer(
'DSYRFSX', infot, nout, lerr, ok )
306 CALL dsyrfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 1, x, 2,
307 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
308 $ params, w, iw, info )
309 CALL chkxer(
'DSYRFSX', infot, nout, lerr, ok )
311 CALL dsyrfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 2, x, 1,
312 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
313 $ params, w, iw, info )
314 CALL chkxer(
'DSYRFSX', infot, nout, lerr, ok )
320 CALL dsycon(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
321 CALL chkxer(
'DSYCON', infot, nout, lerr, ok )
323 CALL dsycon(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
324 CALL chkxer(
'DSYCON', infot, nout, lerr, ok )
326 CALL dsycon(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
327 CALL chkxer(
'DSYCON', infot, nout, lerr, ok )
329 CALL dsycon(
'U', 1, a, 1, ip, -1.0d0, rcond, w, iw, info )
330 CALL chkxer(
'DSYCON', infot, nout, lerr, ok )
332 ELSE IF(
lsamen( 2, c2,
'SR' ) )
THEN
340 srnamt =
'DSYTRF_ROOK'
343 CALL chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
346 CALL chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
349 CALL chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
352 CALL chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
355 CALL chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
359 srnamt =
'DSYTF2_ROOK'
362 CALL chkxer(
'DSYTF2_ROOK', infot, nout, lerr, ok )
365 CALL chkxer(
'DSYTF2_ROOK', infot, nout, lerr, ok )
368 CALL chkxer(
'DSYTF2_ROOK', infot, nout, lerr, ok )
372 srnamt =
'DSYTRI_ROOK'
375 CALL chkxer(
'DSYTRI_ROOK', infot, nout, lerr, ok )
378 CALL chkxer(
'DSYTRI_ROOK', infot, nout, lerr, ok )
381 CALL chkxer(
'DSYTRI_ROOK', infot, nout, lerr, ok )
385 srnamt =
'DSYTRS_ROOK'
387 CALL dsytrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
388 CALL chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
390 CALL dsytrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
391 CALL chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
393 CALL dsytrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
394 CALL chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
396 CALL dsytrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
397 CALL chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
399 CALL dsytrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
400 CALL chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
404 srnamt =
'DSYCON_ROOK'
406 CALL dsycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
407 CALL chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
409 CALL dsycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
410 CALL chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
412 CALL dsycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
413 CALL chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
415 CALL dsycon_rook(
'U', 1, a, 1, ip, -1.0d0, rcond, w, iw, info)
416 CALL chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
418 ELSE IF(
lsamen( 2, c2,
'SK' ) )
THEN
432 CALL dsytrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
433 CALL chkxer(
'DSYTRF_RK', infot, nout, lerr, ok )
435 CALL dsytrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
436 CALL chkxer(
'DSYTRF_RK', infot, nout, lerr, ok )
438 CALL dsytrf_rk(
'U', 2, a, 1, e, ip, w, 1, info )
439 CALL chkxer(
'DSYTRF_RK', infot, nout, lerr, ok )
441 CALL dsytrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
442 CALL chkxer(
'DSYTRF_RK', infot, nout, lerr, ok )
444 CALL dsytrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
445 CALL chkxer(
'DSYTRF_RK', infot, nout, lerr, ok )
451 CALL dsytf2_rk(
'/', 0, a, 1, e, ip, info )
452 CALL chkxer(
'DSYTF2_RK', infot, nout, lerr, ok )
454 CALL dsytf2_rk(
'U', -1, a, 1, e, ip, info )
455 CALL chkxer(
'DSYTF2_RK', infot, nout, lerr, ok )
457 CALL dsytf2_rk(
'U', 2, a, 1, e, ip, info )
458 CALL chkxer(
'DSYTF2_RK', infot, nout, lerr, ok )
464 CALL dsytri_3(
'/', 0, a, 1, e, ip, w, 1, info )
465 CALL chkxer(
'DSYTRI_3', infot, nout, lerr, ok )
467 CALL dsytri_3(
'U', -1, a, 1, e, ip, w, 1, info )
468 CALL chkxer(
'DSYTRI_3', infot, nout, lerr, ok )
470 CALL dsytri_3(
'U', 2, a, 1, e, ip, w, 1, info )
471 CALL chkxer(
'DSYTRI_3', infot, nout, lerr, ok )
473 CALL dsytri_3(
'U', 0, a, 1, e, ip, w, 0, info )
474 CALL chkxer(
'DSYTRI_3', infot, nout, lerr, ok )
476 CALL dsytri_3(
'U', 0, a, 1, e, ip, w, -2, info )
477 CALL chkxer(
'DSYTRI_3', infot, nout, lerr, ok )
483 CALL dsytri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
484 CALL chkxer(
'DSYTRI_3X', infot, nout, lerr, ok )
486 CALL dsytri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
487 CALL chkxer(
'DSYTRI_3X', infot, nout, lerr, ok )
489 CALL dsytri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
490 CALL chkxer(
'DSYTRI_3X', infot, nout, lerr, ok )
496 CALL dsytrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
497 CALL chkxer(
'DSYTRS_3', infot, nout, lerr, ok )
499 CALL dsytrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
500 CALL chkxer(
'DSYTRS_3', infot, nout, lerr, ok )
502 CALL dsytrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
503 CALL chkxer(
'DSYTRS_3', infot, nout, lerr, ok )
505 CALL dsytrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
506 CALL chkxer(
'DSYTRS_3', infot, nout, lerr, ok )
508 CALL dsytrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
509 CALL chkxer(
'DSYTRS_3', infot, nout, lerr, ok )
515 CALL dsycon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, iw,
517 CALL chkxer(
'DSYCON_3', infot, nout, lerr, ok )
519 CALL dsycon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, iw,
521 CALL chkxer(
'DSYCON_3', infot, nout, lerr, ok )
523 CALL dsycon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, iw,
525 CALL chkxer(
'DSYCON_3', infot, nout, lerr, ok )
527 CALL dsycon_3(
'U', 1, a, 1, e, ip, -1.0d0, rcond, w, iw,
529 CALL chkxer(
'DSYCON_3', infot, nout, lerr, ok )
531 ELSE IF(
lsamen( 2, c2,
'SP' ) )
THEN
541 CALL dsptrf(
'/', 0, a, ip, info )
542 CALL chkxer(
'DSPTRF', infot, nout, lerr, ok )
544 CALL dsptrf(
'U', -1, a, ip, info )
545 CALL chkxer(
'DSPTRF', infot, nout, lerr, ok )
551 CALL dsptri(
'/', 0, a, ip, w, info )
552 CALL chkxer(
'DSPTRI', infot, nout, lerr, ok )
554 CALL dsptri(
'U', -1, a, ip, w, info )
555 CALL chkxer(
'DSPTRI', infot, nout, lerr, ok )
561 CALL dsptrs(
'/', 0, 0, a, ip, b, 1, info )
562 CALL chkxer(
'DSPTRS', infot, nout, lerr, ok )
564 CALL dsptrs(
'U', -1, 0, a, ip, b, 1, info )
565 CALL chkxer(
'DSPTRS', infot, nout, lerr, ok )
567 CALL dsptrs(
'U', 0, -1, a, ip, b, 1, info )
568 CALL chkxer(
'DSPTRS', infot, nout, lerr, ok )
570 CALL dsptrs(
'U', 2, 1, a, ip, b, 1, info )
571 CALL chkxer(
'DSPTRS', infot, nout, lerr, ok )
577 CALL dsprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
579 CALL chkxer(
'DSPRFS', infot, nout, lerr, ok )
581 CALL dsprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
583 CALL chkxer(
'DSPRFS', infot, nout, lerr, ok )
585 CALL dsprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
587 CALL chkxer(
'DSPRFS', infot, nout, lerr, ok )
589 CALL dsprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, iw,
591 CALL chkxer(
'DSPRFS', infot, nout, lerr, ok )
593 CALL dsprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, iw,
595 CALL chkxer(
'DSPRFS', infot, nout, lerr, ok )
601 CALL dspcon(
'/', 0, a, ip, anrm, rcond, w, iw, info )
602 CALL chkxer(
'DSPCON', infot, nout, lerr, ok )
604 CALL dspcon(
'U', -1, a, ip, anrm, rcond, w, iw, info )
605 CALL chkxer(
'DSPCON', infot, nout, lerr, ok )
607 CALL dspcon(
'U', 1, a, ip, -1.0d0, rcond, w, iw, info )
608 CALL chkxer(
'DSPCON', infot, nout, lerr, ok )
613 CALL alaesm( path, ok, nout )
subroutine dsytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS_ROOK
subroutine dsytri_3x(UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO)
DSYTRI_3X
subroutine dsptri(UPLO, N, AP, IPIV, WORK, INFO)
DSPTRI
subroutine dsycon_3(UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON_3
subroutine dsyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DSYRFS
subroutine dsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRI2
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine dsytri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
DSYTRI_3
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...
subroutine dsytf2(UPLO, N, A, LDA, IPIV, INFO)
DSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
subroutine dsytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
DSYTRI_ROOK
subroutine dsytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
DSYTRI
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...
subroutine dsycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON
subroutine dsycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON_ROOK
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine dsprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DSPRFS
subroutine dspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSPCON
logical function lsamen(N, CA, CB)
LSAMEN
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
subroutine dsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS
subroutine dsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF
subroutine derrsy(PATH, NUNIT)
DERRSY
subroutine dsytrs_3(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO)
DSYTRS_3
subroutine dsytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF_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-...
subroutine dsptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
DSPTRS
subroutine dsptrf(UPLO, N, AP, IPIV, INFO)
DSPTRF
subroutine dsytri2x(UPLO, N, A, LDA, IPIV, WORK, NB, INFO)
DSYTRI2X