56 SUBROUTINE serrsy( PATH, NUNIT )
72 parameter ( nmax = 4 )
80 INTEGER IP( nmax ), IW( nmax )
81 REAL A( nmax, nmax ), AF( nmax, nmax ), B( nmax ),
82 $ e( nmax ), r1( nmax ), r2( nmax ), w( 3*nmax ),
104 COMMON / infoc / infot, nout, ok, lerr
105 COMMON / srnamc / srnamt
113 WRITE( nout, fmt = * )
120 a( i, j ) = 1. /
REAL( i+j )
121 af( i, j ) = 1. /
REAL( i+j )
136 IF( lsamen( 2, c2,
'SY' ) )
THEN
146 CALL ssytrf(
'/', 0, a, 1, ip, w, 1, info )
147 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
149 CALL ssytrf(
'U', -1, a, 1, ip, w, 1, info )
150 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
152 CALL ssytrf(
'U', 2, a, 1, ip, w, 4, info )
153 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
155 CALL ssytrf(
'U', 0, a, 1, ip, w, 0, info )
156 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
158 CALL ssytrf(
'U', 0, a, 1, ip, w, -2, info )
159 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
165 CALL ssytf2(
'/', 0, a, 1, ip, info )
166 CALL chkxer(
'SSYTF2', infot, nout, lerr, ok )
168 CALL ssytf2(
'U', -1, a, 1, ip, info )
169 CALL chkxer(
'SSYTF2', infot, nout, lerr, ok )
171 CALL ssytf2(
'U', 2, a, 1, ip, info )
172 CALL chkxer(
'SSYTF2', infot, nout, lerr, ok )
178 CALL ssytri(
'/', 0, a, 1, ip, w, info )
179 CALL chkxer(
'SSYTRI', infot, nout, lerr, ok )
181 CALL ssytri(
'U', -1, a, 1, ip, w, info )
182 CALL chkxer(
'SSYTRI', infot, nout, lerr, ok )
184 CALL ssytri(
'U', 2, a, 1, ip, w, info )
185 CALL chkxer(
'SSYTRI', infot, nout, lerr, ok )
191 CALL ssytri2(
'/', 0, a, 1, ip, w, iw(1), info )
192 CALL chkxer(
'SSYTRI2', infot, nout, lerr, ok )
194 CALL ssytri2(
'U', -1, a, 1, ip, w, iw(1), info )
195 CALL chkxer(
'SSYTRI2', infot, nout, lerr, ok )
197 CALL ssytri2(
'U', 2, a, 1, ip, w, iw(1), info )
198 CALL chkxer(
'SSYTRI2', infot, nout, lerr, ok )
204 CALL ssytri2x(
'/', 0, a, 1, ip, w, 1, info )
205 CALL chkxer(
'SSYTRI2X', infot, nout, lerr, ok )
207 CALL ssytri2x(
'U', -1, a, 1, ip, w, 1, info )
208 CALL chkxer(
'SSYTRI2X', infot, nout, lerr, ok )
210 CALL ssytri2x(
'U', 2, a, 1, ip, w, 1, info )
211 CALL chkxer(
'SSYTRI2X', infot, nout, lerr, ok )
217 CALL ssytrs(
'/', 0, 0, a, 1, ip, b, 1, info )
218 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
220 CALL ssytrs(
'U', -1, 0, a, 1, ip, b, 1, info )
221 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
223 CALL ssytrs(
'U', 0, -1, a, 1, ip, b, 1, info )
224 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
226 CALL ssytrs(
'U', 2, 1, a, 1, ip, b, 2, info )
227 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
229 CALL ssytrs(
'U', 2, 1, a, 2, ip, b, 1, info )
230 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
236 CALL ssyrfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
238 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
240 CALL ssyrfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
242 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
244 CALL ssyrfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
246 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
248 CALL ssyrfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
250 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
252 CALL ssyrfs(
'U', 2, 1, a, 2, af, 1, 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, 2, ip, b, 1, 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, 2, x, 1, r1, r2, w,
262 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
268 CALL ssycon(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
269 CALL chkxer(
'SSYCON', infot, nout, lerr, ok )
271 CALL ssycon(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
272 CALL chkxer(
'SSYCON', infot, nout, lerr, ok )
274 CALL ssycon(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
275 CALL chkxer(
'SSYCON', infot, nout, lerr, ok )
277 CALL ssycon(
'U', 1, a, 1, ip, -1.0, rcond, w, iw, info )
278 CALL chkxer(
'SSYCON', infot, nout, lerr, ok )
280 ELSE IF( lsamen( 2, c2,
'SR' ) )
THEN
288 srnamt =
'SSYTRF_ROOK'
291 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
294 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
297 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
300 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
303 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
307 srnamt =
'SSYTF2_ROOK'
310 CALL chkxer(
'SSYTF2_ROOK', infot, nout, lerr, ok )
313 CALL chkxer(
'SSYTF2_ROOK', infot, nout, lerr, ok )
316 CALL chkxer(
'SSYTF2_ROOK', infot, nout, lerr, ok )
320 srnamt =
'SSYTRI_ROOK'
323 CALL chkxer(
'SSYTRI_ROOK', infot, nout, lerr, ok )
326 CALL chkxer(
'SSYTRI_ROOK', infot, nout, lerr, ok )
329 CALL chkxer(
'SSYTRI_ROOK', infot, nout, lerr, ok )
333 srnamt =
'SSYTRS_ROOK'
335 CALL ssytrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
336 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
338 CALL ssytrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
339 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
341 CALL ssytrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
342 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
344 CALL ssytrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
345 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
347 CALL ssytrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
348 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
352 srnamt =
'SSYCON_ROOK'
354 CALL ssycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
355 CALL chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
357 CALL ssycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
358 CALL chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
360 CALL ssycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
361 CALL chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
363 CALL ssycon_rook(
'U', 1, a, 1, ip, -1.0, rcond, w, iw, info )
364 CALL chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
366 ELSE IF( lsamen( 2, c2,
'SK' ) )
THEN
380 CALL ssytrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
381 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
383 CALL ssytrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
384 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
386 CALL ssytrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
387 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
389 CALL ssytrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
390 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
392 CALL ssytrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
393 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
399 CALL ssytf2_rk(
'/', 0, a, 1, e, ip, info )
400 CALL chkxer(
'SSYTF2_RK', infot, nout, lerr, ok )
402 CALL ssytf2_rk(
'U', -1, a, 1, e, ip, info )
403 CALL chkxer(
'SSYTF2_RK', infot, nout, lerr, ok )
405 CALL ssytf2_rk(
'U', 2, a, 1, e, ip, info )
406 CALL chkxer(
'SSYTF2_RK', infot, nout, lerr, ok )
412 CALL ssytri_3(
'/', 0, a, 1, e, ip, w, 1, info )
413 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
415 CALL ssytri_3(
'U', -1, a, 1, e, ip, w, 1, info )
416 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
418 CALL ssytri_3(
'U', 2, a, 1, e, ip, w, 1, info )
419 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
421 CALL ssytri_3(
'U', 0, a, 1, e, ip, w, 0, info )
422 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
424 CALL ssytri_3(
'U', 0, a, 1, e, ip, w, -2, info )
425 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
431 CALL ssytri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
432 CALL chkxer(
'SSYTRI_3X', infot, nout, lerr, ok )
434 CALL ssytri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
435 CALL chkxer(
'SSYTRI_3X', infot, nout, lerr, ok )
437 CALL ssytri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
438 CALL chkxer(
'SSYTRI_3X', infot, nout, lerr, ok )
444 CALL ssytrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
445 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
447 CALL ssytrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
448 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
450 CALL ssytrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
451 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
453 CALL ssytrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
454 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
456 CALL ssytrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
457 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
463 CALL ssycon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, iw,
465 CALL chkxer(
'SSYCON_3', infot, nout, lerr, ok )
467 CALL ssycon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, iw,
469 CALL chkxer(
'SSYCON_3', infot, nout, lerr, ok )
471 CALL ssycon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, iw,
473 CALL chkxer(
'SSYCON_3', infot, nout, lerr, ok )
475 CALL ssycon_3(
'U', 1, a, 1, e, ip, -1.0e0, rcond, w, iw,
477 CALL chkxer(
'SSYCON_3', infot, nout, lerr, ok )
479 ELSE IF( lsamen( 2, c2,
'SA' ) )
THEN
488 CALL ssytrf_aa(
'/', 0, a, 1, ip, w, 1, info )
489 CALL chkxer(
'SSYTRF_AA', infot, nout, lerr, ok )
491 CALL ssytrf_aa(
'U', -1, a, 1, ip, w, 1, info )
492 CALL chkxer(
'SSYTRF_AA', infot, nout, lerr, ok )
494 CALL ssytrf_aa(
'U', 2, a, 1, ip, w, 4, info )
495 CALL chkxer(
'SSYTRF_AA', infot, nout, lerr, ok )
497 CALL ssytrf_aa(
'U', 0, a, 1, ip, w, 0, info )
498 CALL chkxer(
'SSYTRF_AA', infot, nout, lerr, ok )
500 CALL ssytrf_aa(
'U', 0, a, 1, ip, w, -2, info )
501 CALL chkxer(
'SSYTRF_AA', infot, nout, lerr, ok )
507 CALL ssytrs_aa(
'/', 0, 0, a, 1, ip, b, 1, w, 1, info )
508 CALL chkxer(
'SSYTRS_AA', infot, nout, lerr, ok )
510 CALL ssytrs_aa(
'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
511 CALL chkxer(
'SSYTRS_AA', infot, nout, lerr, ok )
513 CALL ssytrs_aa(
'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
514 CALL chkxer(
'SSYTRS_AA', infot, nout, lerr, ok )
516 CALL ssytrs_aa(
'U', 2, 1, a, 1, ip, b, 2, w, 1, info )
517 CALL chkxer(
'SSYTRS_AA', infot, nout, lerr, ok )
519 CALL ssytrs_aa(
'U', 2, 1, a, 2, ip, b, 1, w, 1, info )
520 CALL chkxer(
'SSYTRS_AA', infot, nout, lerr, ok )
522 CALL ssytrs_aa(
'U', 0, 1, a, 2, ip, b, 1, w, 0, info )
523 CALL chkxer(
'SSYTRS_AA', infot, nout, lerr, ok )
525 CALL ssytrs_aa(
'U', 0, 1, a, 2, ip, b, 1, w, -2, info )
526 CALL chkxer(
'SSYTRS_AA', infot, nout, lerr, ok )
528 ELSE IF( lsamen( 2, c2,
'SP' ) )
THEN
538 CALL ssptrf(
'/', 0, a, ip, info )
539 CALL chkxer(
'SSPTRF', infot, nout, lerr, ok )
541 CALL ssptrf(
'U', -1, a, ip, info )
542 CALL chkxer(
'SSPTRF', infot, nout, lerr, ok )
548 CALL ssptri(
'/', 0, a, ip, w, info )
549 CALL chkxer(
'SSPTRI', infot, nout, lerr, ok )
551 CALL ssptri(
'U', -1, a, ip, w, info )
552 CALL chkxer(
'SSPTRI', infot, nout, lerr, ok )
558 CALL ssptrs(
'/', 0, 0, a, ip, b, 1, info )
559 CALL chkxer(
'SSPTRS', infot, nout, lerr, ok )
561 CALL ssptrs(
'U', -1, 0, a, ip, b, 1, info )
562 CALL chkxer(
'SSPTRS', infot, nout, lerr, ok )
564 CALL ssptrs(
'U', 0, -1, a, ip, b, 1, info )
565 CALL chkxer(
'SSPTRS', infot, nout, lerr, ok )
567 CALL ssptrs(
'U', 2, 1, a, ip, b, 1, info )
568 CALL chkxer(
'SSPTRS', infot, nout, lerr, ok )
574 CALL ssprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
576 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
578 CALL ssprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
580 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
582 CALL ssprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
584 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
586 CALL ssprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, iw,
588 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
590 CALL ssprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, iw,
592 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
598 CALL sspcon(
'/', 0, a, ip, anrm, rcond, w, iw, info )
599 CALL chkxer(
'SSPCON', infot, nout, lerr, ok )
601 CALL sspcon(
'U', -1, a, ip, anrm, rcond, w, iw, info )
602 CALL chkxer(
'SSPCON', infot, nout, lerr, ok )
604 CALL sspcon(
'U', 1, a, ip, -1.0, rcond, w, iw, info )
605 CALL chkxer(
'SSPCON', infot, nout, lerr, ok )
610 CALL alaesm( path, ok, nout )
subroutine ssytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRI2
subroutine ssytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRF_AA
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 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...
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 ssytrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
SSYTRS_AA
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 ...