166 SUBROUTINE ddrvpo( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
167 $ a, afac, asav, b, bsav, x, xact, s, work,
168 $ rwork, iwork, nout )
177 INTEGER NMAX, NN, NOUT, NRHS
178 DOUBLE PRECISION THRESH
182 INTEGER IWORK( * ), NVAL( * )
183 DOUBLE PRECISION A( * ), AFAC( * ), ASAV( * ), B( * ),
184 $ bsav( * ), rwork( * ), s( * ), work( * ),
191 DOUBLE PRECISION ONE, ZERO
192 parameter( one = 1.0d+0, zero = 0.0d+0 )
194 parameter( ntypes = 9 )
196 parameter( ntests = 6 )
199 LOGICAL EQUIL, NOFACT, PREFAC, ZEROT
200 CHARACTER DIST, EQUED, FACT,
TYPE, UPLO, XTYPE
202 INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
203 $ izero, k, k1, kl, ku, lda, mode, n, nb, nbmin,
204 $ nerrs, nfact, nfail, nimat, nrun, nt,
206 DOUBLE PRECISION AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC,
207 $ roldc, scond, rpvgrw_svxx
210 CHARACTER EQUEDS( 2 ), FACTS( 3 ), UPLOS( 2 )
211 INTEGER ISEED( 4 ), ISEEDY( 4 )
212 DOUBLE PRECISION RESULT( ntests ), BERR( nrhs ),
213 $ errbnds_n( nrhs, 3 ), errbnds_c( nrhs, 3 )
217 DOUBLE PRECISION DGET06, DLANSY
218 EXTERNAL lsame, dget06, dlansy
235 COMMON / infoc / infot, nunit, ok, lerr
236 COMMON / srnamc / srnamt
239 DATA iseedy / 1988, 1989, 1990, 1991 /
240 DATA uplos /
'U',
'L' /
241 DATA facts /
'F',
'N',
'E' /
242 DATA equeds /
'N',
'Y' /
248 path( 1: 1 ) =
'Double precision'
254 iseed( i ) = iseedy( i )
260 $ CALL
derrvx( path, nout )
280 DO 120 imat = 1, nimat
284 IF( .NOT.dotype( imat ) )
289 zerot = imat.GE.3 .AND. imat.LE.5
290 IF( zerot .AND. n.LT.imat-2 )
296 uplo = uplos( iuplo )
301 CALL
dlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
305 CALL
dlatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
306 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
312 CALL
alaerh( path,
'DLATMS', info, 0, uplo, n, n, -1,
313 $ -1, -1, imat, nfail, nerrs, nout )
323 ELSE IF( imat.EQ.4 )
THEN
328 ioff = ( izero-1 )*lda
332 IF( iuplo.EQ.1 )
THEN
333 DO 20 i = 1, izero - 1
343 DO 40 i = 1, izero - 1
358 CALL
dlacpy( uplo, n, n, a, lda, asav, lda )
361 equed = equeds( iequed )
362 IF( iequed.EQ.1 )
THEN
368 DO 90 ifact = 1, nfact
369 fact = facts( ifact )
370 prefac = lsame( fact,
'F' )
371 nofact = lsame( fact,
'N' )
372 equil = lsame( fact,
'E' )
379 ELSE IF( .NOT.lsame( fact,
'N' ) )
THEN
386 CALL
dlacpy( uplo, n, n, asav, lda, afac, lda )
387 IF( equil .OR. iequed.GT.1 )
THEN
392 CALL
dpoequ( n, afac, lda, s, scond, amax,
394 IF( info.EQ.0 .AND. n.GT.0 )
THEN
400 CALL
dlaqsy( uplo, n, afac, lda, s, scond,
413 anorm = dlansy(
'1', uplo, n, afac, lda, rwork )
417 CALL
dpotrf( uplo, n, afac, lda, info )
421 CALL
dlacpy( uplo, n, n, afac, lda, a, lda )
422 CALL
dpotri( uplo, n, a, lda, info )
426 ainvnm = dlansy(
'1', uplo, n, a, lda, rwork )
427 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
430 rcondc = ( one / anorm ) / ainvnm
436 CALL
dlacpy( uplo, n, n, asav, lda, a, lda )
441 CALL
dlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
442 $ nrhs, a, lda, xact, lda, b, lda,
445 CALL
dlacpy(
'Full', n, nrhs, b, lda, bsav, lda )
454 CALL
dlacpy( uplo, n, n, a, lda, afac, lda )
455 CALL
dlacpy(
'Full', n, nrhs, b, lda, x, lda )
458 CALL
dposv( uplo, n, nrhs, afac, lda, x, lda,
463 IF( info.NE.izero )
THEN
464 CALL
alaerh( path,
'DPOSV ', info, izero,
465 $ uplo, n, n, -1, -1, nrhs, imat,
466 $ nfail, nerrs, nout )
468 ELSE IF( info.NE.0 )
THEN
475 CALL
dpot01( uplo, n, a, lda, afac, lda, rwork,
480 CALL
dlacpy(
'Full', n, nrhs, b, lda, work,
482 CALL
dpot02( uplo, n, nrhs, a, lda, x, lda,
483 $ work, lda, rwork, result( 2 ) )
487 CALL
dget04( n, nrhs, x, lda, xact, lda, rcondc,
495 IF( result( k ).GE.thresh )
THEN
496 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
497 $ CALL
aladhd( nout, path )
498 WRITE( nout, fmt = 9999 )
'DPOSV ', uplo,
499 $ n, imat, k, result( k )
510 $ CALL
dlaset( uplo, n, n, zero, zero, afac, lda )
511 CALL
dlaset(
'Full', n, nrhs, zero, zero, x, lda )
512 IF( iequed.GT.1 .AND. n.GT.0 )
THEN
517 CALL
dlaqsy( uplo, n, a, lda, s, scond, amax,
525 CALL
dposvx( fact, uplo, n, nrhs, a, lda, afac,
526 $ lda, equed, s, b, lda, x, lda, rcond,
527 $ rwork, rwork( nrhs+1 ), work, iwork,
532 IF( info.NE.izero )
THEN
533 CALL
alaerh( path,
'DPOSVX', info, izero,
534 $ fact // uplo, n, n, -1, -1, nrhs,
535 $ imat, nfail, nerrs, nout )
540 IF( .NOT.prefac )
THEN
545 CALL
dpot01( uplo, n, a, lda, afac, lda,
546 $ rwork( 2*nrhs+1 ), result( 1 ) )
554 CALL
dlacpy(
'Full', n, nrhs, bsav, lda, work,
556 CALL
dpot02( uplo, n, nrhs, asav, lda, x, lda,
557 $ work, lda, rwork( 2*nrhs+1 ),
562 IF( nofact .OR. ( prefac .AND. lsame( equed,
564 CALL
dget04( n, nrhs, x, lda, xact, lda,
565 $ rcondc, result( 3 ) )
567 CALL
dget04( n, nrhs, x, lda, xact, lda,
568 $ roldc, result( 3 ) )
574 CALL
dpot05( uplo, n, nrhs, asav, lda, b, lda,
575 $ x, lda, xact, lda, rwork,
576 $ rwork( nrhs+1 ), result( 4 ) )
584 result( 6 ) = dget06( rcond, rcondc )
590 IF( result( k ).GE.thresh )
THEN
591 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
592 $ CALL
aladhd( nout, path )
594 WRITE( nout, fmt = 9997 )
'DPOSVX', fact,
595 $ uplo, n, equed, imat, k, result( k )
597 WRITE( nout, fmt = 9998 )
'DPOSVX', fact,
598 $ uplo, n, imat, k, result( k )
609 CALL
dlacpy(
'Full', n, n, asav, lda, a, lda )
610 CALL
dlacpy(
'Full', n, nrhs, bsav, lda, b, lda )
613 $ CALL
dlaset( uplo, n, n, zero, zero, afac, lda )
614 CALL
dlaset(
'Full', n, nrhs, zero, zero, x, lda )
615 IF( iequed.GT.1 .AND. n.GT.0 )
THEN
620 CALL
dlaqsy( uplo, n, a, lda, s, scond, amax,
629 CALL
dposvxx( fact, uplo, n, nrhs, a, lda, afac,
630 $ lda, equed, s, b, lda, x,
631 $ lda, rcond, rpvgrw_svxx, berr, n_err_bnds,
632 $ errbnds_n, errbnds_c, 0, zero, work,
637 IF( info.EQ.n+1 ) goto 90
638 IF( info.NE.izero )
THEN
639 CALL
alaerh( path,
'DPOSVXX', info, izero,
640 $ fact // uplo, n, n, -1, -1, nrhs,
641 $ imat, nfail, nerrs, nout )
646 IF( .NOT.prefac )
THEN
651 CALL
dpot01( uplo, n, a, lda, afac, lda,
652 $ rwork( 2*nrhs+1 ), result( 1 ) )
660 CALL
dlacpy(
'Full', n, nrhs, bsav, lda, work,
662 CALL
dpot02( uplo, n, nrhs, asav, lda, x, lda,
663 $ work, lda, rwork( 2*nrhs+1 ),
668 IF( nofact .OR. ( prefac .AND. lsame( equed,
670 CALL
dget04( n, nrhs, x, lda, xact, lda,
671 $ rcondc, result( 3 ) )
673 CALL
dget04( n, nrhs, x, lda, xact, lda,
674 $ roldc, result( 3 ) )
680 CALL
dpot05( uplo, n, nrhs, asav, lda, b, lda,
681 $ x, lda, xact, lda, rwork,
682 $ rwork( nrhs+1 ), result( 4 ) )
690 result( 6 ) = dget06( rcond, rcondc )
696 IF( result( k ).GE.thresh )
THEN
697 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
698 $ CALL
aladhd( nout, path )
700 WRITE( nout, fmt = 9997 )
'DPOSVXX', fact,
701 $ uplo, n, equed, imat, k, result( k )
703 WRITE( nout, fmt = 9998 )
'DPOSVXX', fact,
704 $ uplo, n, imat, k, result( k )
718 CALL
alasvm( path, nout, nfail, nrun, nerrs )
725 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i1,
726 $
', test(', i1,
')=', g12.5 )
727 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N=', i5,
728 $
', type ', i1,
', test(', i1,
')=', g12.5 )
729 9997
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N=', i5,
730 $
', EQUED=''', a1,
''', type ', i1,
', test(', i1,
') =',
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
subroutine dpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DPOT02
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine dposvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
DPOSVX computes the solution to system of linear equations A * X = B for PO matrices ...
subroutine dpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DPOT05
subroutine derrvx(PATH, NUNIT)
DERRVX
subroutine dposv(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
DPOSV computes the solution to system of linear equations A * X = B for PO matrices ...
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine dlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
DLARHS
subroutine dpot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
DPOT01
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
subroutine dlaqsy(UPLO, N, A, LDA, S, SCOND, AMAX, EQUED)
DLAQSY scales a symmetric/Hermitian matrix, using scaling factors computed by spoequ.
subroutine dposvxx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO)
DPOSVXX computes the solution to system of linear equations A * X = B for PO matrices ...
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine debchvxx(THRESH, PATH)
DEBCHVXX
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine dpoequ(N, A, LDA, S, SCOND, AMAX, INFO)
DPOEQU
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine dpotri(UPLO, N, A, LDA, INFO)
DPOTRI
subroutine dpotrf(UPLO, N, A, LDA, INFO)
DPOTRF
subroutine ddrvpo(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
DDRVPO