72 parameter ( nmax = 4 )
77 DOUBLE PRECISION anrm, rcond
80 INTEGER ip( nmax ), iw( nmax )
81 DOUBLE PRECISION 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.d0 / dble( i+j )
121 af( i, j ) = 1.d0 / dble( i+j )
136 IF(
lsamen( 2, c2,
'SY' ) )
THEN
146 CALL dsytrf(
'/', 0, a, 1, ip, w, 1, info )
147 CALL chkxer(
'DSYTRF', infot, nout, lerr, ok )
149 CALL dsytrf(
'U', -1, a, 1, ip, w, 1, info )
150 CALL chkxer(
'DSYTRF', infot, nout, lerr, ok )
152 CALL dsytrf(
'U', 2, a, 1, ip, w, 4, info )
153 CALL chkxer(
'DSYTRF', infot, nout, lerr, ok )
155 CALL dsytrf(
'U', 0, a, 1, ip, w, 0, info )
156 CALL chkxer(
'DSYTRF', infot, nout, lerr, ok )
158 CALL dsytrf(
'U', 0, a, 1, ip, w, -2, info )
159 CALL chkxer(
'DSYTRF', infot, nout, lerr, ok )
165 CALL dsytf2(
'/', 0, a, 1, ip, info )
166 CALL chkxer(
'DSYTF2', infot, nout, lerr, ok )
168 CALL dsytf2(
'U', -1, a, 1, ip, info )
169 CALL chkxer(
'DSYTF2', infot, nout, lerr, ok )
171 CALL dsytf2(
'U', 2, a, 1, ip, info )
172 CALL chkxer(
'DSYTF2', infot, nout, lerr, ok )
178 CALL dsytri(
'/', 0, a, 1, ip, w, info )
179 CALL chkxer(
'DSYTRI', infot, nout, lerr, ok )
181 CALL dsytri(
'U', -1, a, 1, ip, w, info )
182 CALL chkxer(
'DSYTRI', infot, nout, lerr, ok )
184 CALL dsytri(
'U', 2, a, 1, ip, w, info )
185 CALL chkxer(
'DSYTRI', infot, nout, lerr, ok )
191 CALL dsytri2(
'/', 0, a, 1, ip, w, iw(1), info )
192 CALL chkxer(
'DSYTRI2', infot, nout, lerr, ok )
194 CALL dsytri2(
'U', -1, a, 1, ip, w, iw(1), info )
195 CALL chkxer(
'DSYTRI2', infot, nout, lerr, ok )
197 CALL dsytri2(
'U', 2, a, 1, ip, w, iw(1), info )
198 CALL chkxer(
'DSYTRI2', infot, nout, lerr, ok )
204 CALL dsytri2x(
'/', 0, a, 1, ip, w, 1, info )
205 CALL chkxer(
'DSYTRI2X', infot, nout, lerr, ok )
207 CALL dsytri2x(
'U', -1, a, 1, ip, w, 1, info )
208 CALL chkxer(
'DSYTRI2X', infot, nout, lerr, ok )
210 CALL dsytri2x(
'U', 2, a, 1, ip, w, 1, info )
211 CALL chkxer(
'DSYTRI2X', infot, nout, lerr, ok )
217 CALL dsytrs(
'/', 0, 0, a, 1, ip, b, 1, info )
218 CALL chkxer(
'DSYTRS', infot, nout, lerr, ok )
220 CALL dsytrs(
'U', -1, 0, a, 1, ip, b, 1, info )
221 CALL chkxer(
'DSYTRS', infot, nout, lerr, ok )
223 CALL dsytrs(
'U', 0, -1, a, 1, ip, b, 1, info )
224 CALL chkxer(
'DSYTRS', infot, nout, lerr, ok )
226 CALL dsytrs(
'U', 2, 1, a, 1, ip, b, 2, info )
227 CALL chkxer(
'DSYTRS', infot, nout, lerr, ok )
229 CALL dsytrs(
'U', 2, 1, a, 2, ip, b, 1, info )
230 CALL chkxer(
'DSYTRS', infot, nout, lerr, ok )
236 CALL dsyrfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
238 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
240 CALL dsyrfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
242 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
244 CALL dsyrfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
246 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
248 CALL dsyrfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
250 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
252 CALL dsyrfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
254 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
256 CALL dsyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
258 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
260 CALL dsyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
262 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
268 CALL dsycon(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
269 CALL chkxer(
'DSYCON', infot, nout, lerr, ok )
271 CALL dsycon(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
272 CALL chkxer(
'DSYCON', infot, nout, lerr, ok )
274 CALL dsycon(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
275 CALL chkxer(
'DSYCON', infot, nout, lerr, ok )
277 CALL dsycon(
'U', 1, a, 1, ip, -1.0d0, rcond, w, iw, info )
278 CALL chkxer(
'DSYCON', infot, nout, lerr, ok )
280 ELSE IF(
lsamen( 2, c2,
'SR' ) )
THEN
288 srnamt =
'DSYTRF_ROOK'
291 CALL chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
294 CALL chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
297 CALL chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
300 CALL chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
303 CALL chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
307 srnamt =
'DSYTF2_ROOK'
310 CALL chkxer(
'DSYTF2_ROOK', infot, nout, lerr, ok )
313 CALL chkxer(
'DSYTF2_ROOK', infot, nout, lerr, ok )
316 CALL chkxer(
'DSYTF2_ROOK', infot, nout, lerr, ok )
320 srnamt =
'DSYTRI_ROOK'
323 CALL chkxer(
'DSYTRI_ROOK', infot, nout, lerr, ok )
326 CALL chkxer(
'DSYTRI_ROOK', infot, nout, lerr, ok )
329 CALL chkxer(
'DSYTRI_ROOK', infot, nout, lerr, ok )
333 srnamt =
'DSYTRS_ROOK'
335 CALL dsytrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
336 CALL chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
338 CALL dsytrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
339 CALL chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
341 CALL dsytrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
342 CALL chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
344 CALL dsytrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
345 CALL chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
347 CALL dsytrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
348 CALL chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
352 srnamt =
'DSYCON_ROOK'
354 CALL dsycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
355 CALL chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
357 CALL dsycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
358 CALL chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
360 CALL dsycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
361 CALL chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
363 CALL dsycon_rook(
'U', 1, a, 1, ip, -1.0d0, rcond, w, iw, info)
364 CALL chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
366 ELSE IF(
lsamen( 2, c2,
'SK' ) )
THEN
380 CALL dsytrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
381 CALL chkxer(
'DSYTRF_RK', infot, nout, lerr, ok )
383 CALL dsytrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
384 CALL chkxer(
'DSYTRF_RK', infot, nout, lerr, ok )
386 CALL dsytrf_rk(
'U', 2, a, 1, e, ip, w, 1, info )
387 CALL chkxer(
'DSYTRF_RK', infot, nout, lerr, ok )
389 CALL dsytrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
390 CALL chkxer(
'DSYTRF_RK', infot, nout, lerr, ok )
392 CALL dsytrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
393 CALL chkxer(
'DSYTRF_RK', infot, nout, lerr, ok )
399 CALL dsytf2_rk(
'/', 0, a, 1, e, ip, info )
400 CALL chkxer(
'DSYTF2_RK', infot, nout, lerr, ok )
402 CALL dsytf2_rk(
'U', -1, a, 1, e, ip, info )
403 CALL chkxer(
'DSYTF2_RK', infot, nout, lerr, ok )
405 CALL dsytf2_rk(
'U', 2, a, 1, e, ip, info )
406 CALL chkxer(
'DSYTF2_RK', infot, nout, lerr, ok )
412 CALL dsytri_3(
'/', 0, a, 1, e, ip, w, 1, info )
413 CALL chkxer(
'DSYTRI_3', infot, nout, lerr, ok )
415 CALL dsytri_3(
'U', -1, a, 1, e, ip, w, 1, info )
416 CALL chkxer(
'DSYTRI_3', infot, nout, lerr, ok )
418 CALL dsytri_3(
'U', 2, a, 1, e, ip, w, 1, info )
419 CALL chkxer(
'DSYTRI_3', infot, nout, lerr, ok )
421 CALL dsytri_3(
'U', 0, a, 1, e, ip, w, 0, info )
422 CALL chkxer(
'DSYTRI_3', infot, nout, lerr, ok )
424 CALL dsytri_3(
'U', 0, a, 1, e, ip, w, -2, info )
425 CALL chkxer(
'DSYTRI_3', infot, nout, lerr, ok )
431 CALL dsytri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
432 CALL chkxer(
'DSYTRI_3X', infot, nout, lerr, ok )
434 CALL dsytri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
435 CALL chkxer(
'DSYTRI_3X', infot, nout, lerr, ok )
437 CALL dsytri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
438 CALL chkxer(
'DSYTRI_3X', infot, nout, lerr, ok )
444 CALL dsytrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
445 CALL chkxer(
'DSYTRS_3', infot, nout, lerr, ok )
447 CALL dsytrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
448 CALL chkxer(
'DSYTRS_3', infot, nout, lerr, ok )
450 CALL dsytrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
451 CALL chkxer(
'DSYTRS_3', infot, nout, lerr, ok )
453 CALL dsytrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
454 CALL chkxer(
'DSYTRS_3', infot, nout, lerr, ok )
456 CALL dsytrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
457 CALL chkxer(
'DSYTRS_3', infot, nout, lerr, ok )
463 CALL dsycon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, iw,
465 CALL chkxer(
'DSYCON_3', infot, nout, lerr, ok )
467 CALL dsycon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, iw,
469 CALL chkxer(
'DSYCON_3', infot, nout, lerr, ok )
471 CALL dsycon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, iw,
473 CALL chkxer(
'DSYCON_3', infot, nout, lerr, ok )
475 CALL dsycon_3(
'U', 1, a, 1, e, ip, -1.0d0, rcond, w, iw,
477 CALL chkxer(
'DSYCON_3', infot, nout, lerr, ok )
479 ELSE IF(
lsamen( 2, c2,
'SA' ) )
THEN
488 CALL dsytrf_aa(
'/', 0, a, 1, ip, w, 1, info )
489 CALL chkxer(
'DSYTRF_AA', infot, nout, lerr, ok )
491 CALL dsytrf_aa(
'U', -1, a, 1, ip, w, 1, info )
492 CALL chkxer(
'DSYTRF_AA', infot, nout, lerr, ok )
494 CALL dsytrf_aa(
'U', 2, a, 1, ip, w, 4, info )
495 CALL chkxer(
'DSYTRF_AA', infot, nout, lerr, ok )
497 CALL dsytrf_aa(
'U', 0, a, 1, ip, w, 0, info )
498 CALL chkxer(
'DSYTRF_AA', infot, nout, lerr, ok )
500 CALL dsytrf_aa(
'U', 0, a, 1, ip, w, -2, info )
501 CALL chkxer(
'DSYTRF_AA', infot, nout, lerr, ok )
507 CALL dsytrs_aa(
'/', 0, 0, a, 1, ip, b, 1, w, 1, info )
508 CALL chkxer(
'DSYTRS_AA', infot, nout, lerr, ok )
510 CALL dsytrs_aa(
'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
511 CALL chkxer(
'DSYTRS_AA', infot, nout, lerr, ok )
513 CALL dsytrs_aa(
'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
514 CALL chkxer(
'DSYTRS_AA', infot, nout, lerr, ok )
516 CALL dsytrs_aa(
'U', 2, 1, a, 1, ip, b, 2, w, 1, info )
517 CALL chkxer(
'DSYTRS_AA', infot, nout, lerr, ok )
519 CALL dsytrs_aa(
'U', 2, 1, a, 2, ip, b, 1, w, 1, info )
520 CALL chkxer(
'DSYTRS_AA', infot, nout, lerr, ok )
522 CALL dsytrs_aa(
'U', 0, 1, a, 2, ip, b, 1, w, 0, info )
523 CALL chkxer(
'DSYTRS_AA', infot, nout, lerr, ok )
525 CALL dsytrs_aa(
'U', 0, 1, a, 2, ip, b, 1, w, -2, info )
526 CALL chkxer(
'DSYTRS_AA', infot, nout, lerr, ok )
528 ELSE IF(
lsamen( 2, c2,
'SP' ) )
THEN
538 CALL dsptrf(
'/', 0, a, ip, info )
539 CALL chkxer(
'DSPTRF', infot, nout, lerr, ok )
541 CALL dsptrf(
'U', -1, a, ip, info )
542 CALL chkxer(
'DSPTRF', infot, nout, lerr, ok )
548 CALL dsptri(
'/', 0, a, ip, w, info )
549 CALL chkxer(
'DSPTRI', infot, nout, lerr, ok )
551 CALL dsptri(
'U', -1, a, ip, w, info )
552 CALL chkxer(
'DSPTRI', infot, nout, lerr, ok )
558 CALL dsptrs(
'/', 0, 0, a, ip, b, 1, info )
559 CALL chkxer(
'DSPTRS', infot, nout, lerr, ok )
561 CALL dsptrs(
'U', -1, 0, a, ip, b, 1, info )
562 CALL chkxer(
'DSPTRS', infot, nout, lerr, ok )
564 CALL dsptrs(
'U', 0, -1, a, ip, b, 1, info )
565 CALL chkxer(
'DSPTRS', infot, nout, lerr, ok )
567 CALL dsptrs(
'U', 2, 1, a, ip, b, 1, info )
568 CALL chkxer(
'DSPTRS', infot, nout, lerr, ok )
574 CALL dsprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
576 CALL chkxer(
'DSPRFS', infot, nout, lerr, ok )
578 CALL dsprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
580 CALL chkxer(
'DSPRFS', infot, nout, lerr, ok )
582 CALL dsprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
584 CALL chkxer(
'DSPRFS', infot, nout, lerr, ok )
586 CALL dsprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, iw,
588 CALL chkxer(
'DSPRFS', infot, nout, lerr, ok )
590 CALL dsprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, iw,
592 CALL chkxer(
'DSPRFS', infot, nout, lerr, ok )
598 CALL dspcon(
'/', 0, a, ip, anrm, rcond, w, iw, info )
599 CALL chkxer(
'DSPCON', infot, nout, lerr, ok )
601 CALL dspcon(
'U', -1, a, ip, anrm, rcond, w, iw, info )
602 CALL chkxer(
'DSPCON', infot, nout, lerr, ok )
604 CALL dspcon(
'U', 1, a, ip, -1.0d0, rcond, w, iw, info )
605 CALL chkxer(
'DSPCON', infot, nout, lerr, ok )
610 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 dsytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF_AA
subroutine dsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS
subroutine dsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF
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 dsytrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
DSYTRS_AA
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