59 SUBROUTINE serrsy( PATH, NUNIT )
75 parameter ( nmax = 4 )
80 INTEGER i, info, j, n_err_bnds, nparams
81 REAL anrm, rcond, berr
84 INTEGER ip( nmax ), iw( nmax )
85 REAL 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. /
REAL( i+j )
125 af( i, j ) = 1. /
REAL( i+j )
140 IF(
lsamen( 2, c2,
'SY' ) )
THEN
150 CALL ssytrf(
'/', 0, a, 1, ip, w, 1, info )
151 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
153 CALL ssytrf(
'U', -1, a, 1, ip, w, 1, info )
154 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
156 CALL ssytrf(
'U', 2, a, 1, ip, w, 4, info )
157 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
159 CALL ssytrf(
'U', 0, a, 1, ip, w, 0, info )
160 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
162 CALL ssytrf(
'U', 0, a, 1, ip, w, -2, info )
163 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
169 CALL ssytf2(
'/', 0, a, 1, ip, info )
170 CALL chkxer(
'SSYTF2', infot, nout, lerr, ok )
172 CALL ssytf2(
'U', -1, a, 1, ip, info )
173 CALL chkxer(
'SSYTF2', infot, nout, lerr, ok )
175 CALL ssytf2(
'U', 2, a, 1, ip, info )
176 CALL chkxer(
'SSYTF2', infot, nout, lerr, ok )
182 CALL ssytri(
'/', 0, a, 1, ip, w, info )
183 CALL chkxer(
'SSYTRI', infot, nout, lerr, ok )
185 CALL ssytri(
'U', -1, a, 1, ip, w, info )
186 CALL chkxer(
'SSYTRI', infot, nout, lerr, ok )
188 CALL ssytri(
'U', 2, a, 1, ip, w, info )
189 CALL chkxer(
'SSYTRI', infot, nout, lerr, ok )
195 CALL ssytri2(
'/', 0, a, 1, ip, w, iw, info )
196 CALL chkxer(
'SSYTRI', infot, nout, lerr, ok )
198 CALL ssytri2(
'U', -1, a, 1, ip, w, iw, info )
199 CALL chkxer(
'SSYTRI', infot, nout, lerr, ok )
201 CALL ssytri2(
'U', 2, a, 1, ip, w, iw, info )
202 CALL chkxer(
'SSYTRI', infot, nout, lerr, ok )
208 CALL ssytri2x(
'/', 0, a, 1, ip, w, 1, info )
209 CALL chkxer(
'SSYTRI2X', infot, nout, lerr, ok )
211 CALL ssytri2x(
'U', -1, a, 1, ip, w, 1, info )
212 CALL chkxer(
'SSYTRI2X', infot, nout, lerr, ok )
214 CALL ssytri2x(
'U', 2, a, 1, ip, w, 1, info )
215 CALL chkxer(
'SSYTRI2X', infot, nout, lerr, ok )
221 CALL ssytrs(
'/', 0, 0, a, 1, ip, b, 1, info )
222 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
224 CALL ssytrs(
'U', -1, 0, a, 1, ip, b, 1, info )
225 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
227 CALL ssytrs(
'U', 0, -1, a, 1, ip, b, 1, info )
228 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
230 CALL ssytrs(
'U', 2, 1, a, 1, ip, b, 2, info )
231 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
233 CALL ssytrs(
'U', 2, 1, a, 2, ip, b, 1, info )
234 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
240 CALL ssyrfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
242 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
244 CALL ssyrfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
246 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
248 CALL ssyrfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
250 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
252 CALL ssyrfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
254 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
256 CALL ssyrfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
258 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
260 CALL ssyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
262 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
264 CALL ssyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
266 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
274 CALL ssyrfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
275 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
276 $ params, w, iw, info )
277 CALL chkxer(
'SSYRFSX', infot, nout, lerr, ok )
279 CALL ssyrfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
280 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
281 $ params, w, iw, info )
282 CALL chkxer(
'SSYRFSX', infot, nout, lerr, ok )
285 CALL ssyrfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
286 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
287 $ params, w, iw, info )
288 CALL chkxer(
'SSYRFSX', infot, nout, lerr, ok )
290 CALL ssyrfsx(
'U', eq, 0, -1, a, 1, af, 1, ip, s, b, 1, x, 1,
291 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
292 $ params, w, iw, info )
293 CALL chkxer(
'SSYRFSX', infot, nout, lerr, ok )
295 CALL ssyrfsx(
'U', eq, 2, 1, a, 1, af, 2, ip, s, b, 2, x, 2,
296 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
297 $ params, w, iw, info )
298 CALL chkxer(
'SSYRFSX', infot, nout, lerr, ok )
300 CALL ssyrfsx(
'U', eq, 2, 1, a, 2, af, 1, ip, s, b, 2, x, 2,
301 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
302 $ params, w, iw, info )
303 CALL chkxer(
'SSYRFSX', infot, nout, lerr, ok )
305 CALL ssyrfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 1, x, 2,
306 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
307 $ params, w, iw, info )
308 CALL chkxer(
'SSYRFSX', infot, nout, lerr, ok )
310 CALL ssyrfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 2, x, 1,
311 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
312 $ params, w, iw, info )
313 CALL chkxer(
'SSYRFSX', infot, nout, lerr, ok )
319 CALL ssycon(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
320 CALL chkxer(
'SSYCON', infot, nout, lerr, ok )
322 CALL ssycon(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
323 CALL chkxer(
'SSYCON', infot, nout, lerr, ok )
325 CALL ssycon(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
326 CALL chkxer(
'SSYCON', infot, nout, lerr, ok )
328 CALL ssycon(
'U', 1, a, 1, ip, -1.0, rcond, w, iw, info )
329 CALL chkxer(
'SSYCON', infot, nout, lerr, ok )
331 ELSE IF(
lsamen( 2, c2,
'SR' ) )
THEN
339 srnamt =
'SSYTRF_ROOK'
342 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
345 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
348 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
351 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
354 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
358 srnamt =
'SSYTF2_ROOK'
361 CALL chkxer(
'SSYTF2_ROOK', infot, nout, lerr, ok )
364 CALL chkxer(
'SSYTF2_ROOK', infot, nout, lerr, ok )
367 CALL chkxer(
'SSYTF2_ROOK', infot, nout, lerr, ok )
371 srnamt =
'SSYTRI_ROOK'
374 CALL chkxer(
'SSYTRI_ROOK', infot, nout, lerr, ok )
377 CALL chkxer(
'SSYTRI_ROOK', infot, nout, lerr, ok )
380 CALL chkxer(
'SSYTRI_ROOK', infot, nout, lerr, ok )
384 srnamt =
'SSYTRS_ROOK'
386 CALL ssytrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
387 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
389 CALL ssytrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
390 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
392 CALL ssytrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
393 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
395 CALL ssytrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
396 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
398 CALL ssytrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
399 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
403 srnamt =
'SSYCON_ROOK'
405 CALL ssycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
406 CALL chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
408 CALL ssycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
409 CALL chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
411 CALL ssycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
412 CALL chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
414 CALL ssycon_rook(
'U', 1, a, 1, ip, -1.0, rcond, w, iw, info )
415 CALL chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
417 ELSE IF(
lsamen( 2, c2,
'SK' ) )
THEN
431 CALL ssytrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
432 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
434 CALL ssytrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
435 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
437 CALL ssytrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
438 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
440 CALL ssytrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
441 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
443 CALL ssytrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
444 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
450 CALL ssytf2_rk(
'/', 0, a, 1, e, ip, info )
451 CALL chkxer(
'SSYTF2_RK', infot, nout, lerr, ok )
453 CALL ssytf2_rk(
'U', -1, a, 1, e, ip, info )
454 CALL chkxer(
'SSYTF2_RK', infot, nout, lerr, ok )
456 CALL ssytf2_rk(
'U', 2, a, 1, e, ip, info )
457 CALL chkxer(
'SSYTF2_RK', infot, nout, lerr, ok )
463 CALL ssytri_3(
'/', 0, a, 1, e, ip, w, 1, info )
464 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
466 CALL ssytri_3(
'U', -1, a, 1, e, ip, w, 1, info )
467 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
469 CALL ssytri_3(
'U', 2, a, 1, e, ip, w, 1, info )
470 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
472 CALL ssytri_3(
'U', 0, a, 1, e, ip, w, 0, info )
473 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
475 CALL ssytri_3(
'U', 0, a, 1, e, ip, w, -2, info )
476 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
482 CALL ssytri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
483 CALL chkxer(
'SSYTRI_3X', infot, nout, lerr, ok )
485 CALL ssytri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
486 CALL chkxer(
'SSYTRI_3X', infot, nout, lerr, ok )
488 CALL ssytri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
489 CALL chkxer(
'SSYTRI_3X', infot, nout, lerr, ok )
495 CALL ssytrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
496 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
498 CALL ssytrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
499 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
501 CALL ssytrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
502 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
504 CALL ssytrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
505 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
507 CALL ssytrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
508 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
514 CALL ssycon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, iw,
516 CALL chkxer(
'SSYCON_3', infot, nout, lerr, ok )
518 CALL ssycon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, iw,
520 CALL chkxer(
'SSYCON_3', infot, nout, lerr, ok )
522 CALL ssycon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, iw,
524 CALL chkxer(
'SSYCON_3', infot, nout, lerr, ok )
526 CALL ssycon_3(
'U', 1, a, 1, e, ip, -1.0e0, rcond, w, iw,
528 CALL chkxer(
'SSYCON_3', infot, nout, lerr, ok )
530 ELSE IF(
lsamen( 2, c2,
'SP' ) )
THEN
540 CALL ssptrf(
'/', 0, a, ip, info )
541 CALL chkxer(
'SSPTRF', infot, nout, lerr, ok )
543 CALL ssptrf(
'U', -1, a, ip, info )
544 CALL chkxer(
'SSPTRF', infot, nout, lerr, ok )
550 CALL ssptri(
'/', 0, a, ip, w, info )
551 CALL chkxer(
'SSPTRI', infot, nout, lerr, ok )
553 CALL ssptri(
'U', -1, a, ip, w, info )
554 CALL chkxer(
'SSPTRI', infot, nout, lerr, ok )
560 CALL ssptrs(
'/', 0, 0, a, ip, b, 1, info )
561 CALL chkxer(
'SSPTRS', infot, nout, lerr, ok )
563 CALL ssptrs(
'U', -1, 0, a, ip, b, 1, info )
564 CALL chkxer(
'SSPTRS', infot, nout, lerr, ok )
566 CALL ssptrs(
'U', 0, -1, a, ip, b, 1, info )
567 CALL chkxer(
'SSPTRS', infot, nout, lerr, ok )
569 CALL ssptrs(
'U', 2, 1, a, ip, b, 1, info )
570 CALL chkxer(
'SSPTRS', infot, nout, lerr, ok )
576 CALL ssprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
578 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
580 CALL ssprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
582 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
584 CALL ssprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
586 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
588 CALL ssprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, iw,
590 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
592 CALL ssprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, iw,
594 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
600 CALL sspcon(
'/', 0, a, ip, anrm, rcond, w, iw, info )
601 CALL chkxer(
'SSPCON', infot, nout, lerr, ok )
603 CALL sspcon(
'U', -1, a, ip, anrm, rcond, w, iw, info )
604 CALL chkxer(
'SSPCON', infot, nout, lerr, ok )
606 CALL sspcon(
'U', 1, a, ip, -1.0, rcond, w, iw, info )
607 CALL chkxer(
'SSPCON', infot, nout, lerr, ok )
612 CALL alaesm( path, ok, nout )
subroutine ssytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRI2
subroutine ssytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRF_ROOK
subroutine ssytrf_rk(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
SSYTRF_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Ka...
subroutine ssytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS
subroutine ssytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRF
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine ssytf2_rook(UPLO, N, A, LDA, IPIV, INFO)
SSYTF2_ROOK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-...
subroutine ssyrfsx(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)
SSYRFSX
subroutine ssytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
SSYTRI
subroutine ssycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSYCON
subroutine ssycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSYCON_ROOK
subroutine ssytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
SSYTRI_ROOK
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine ssytrs_3(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO)
SSYTRS_3
subroutine ssytf2_rk(UPLO, N, A, LDA, E, IPIV, INFO)
SSYTF2_RK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-Ka...
logical function lsamen(N, CA, CB)
LSAMEN
subroutine ssytri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
SSYTRI_3
subroutine ssptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
SSPTRS
subroutine sspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSPCON
subroutine ssprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SSPRFS
subroutine ssytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS_ROOK
subroutine ssptrf(UPLO, N, AP, IPIV, INFO)
SSPTRF
subroutine ssycon_3(UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSYCON_3
subroutine ssytri_3x(UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO)
SSYTRI_3X
subroutine serrsy(PATH, NUNIT)
SERRSY
subroutine ssytri2x(UPLO, N, A, LDA, IPIV, WORK, NB, INFO)
SSYTRI2X
subroutine ssptri(UPLO, N, AP, IPIV, WORK, INFO)
SSPTRI
subroutine ssyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SSYRFS
subroutine ssytf2(UPLO, N, A, LDA, IPIV, INFO)
SSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...