171 SUBROUTINE dchkpo( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
172 $ thresh, tsterr, nmax, a, afac, ainv,
b,
x,
173 $ xact, work, rwork, iwork, nout )
182 INTEGER nmax, nn, nnb, nns, nout
183 DOUBLE PRECISION thresh
187 INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
188 DOUBLE PRECISION a( * ), afac( * ), ainv( * ),
b( * ),
189 $ rwork( * ), work( * ),
x( * ), xact( * )
195 DOUBLE PRECISION zero
196 parameter( zero = 0.0d+0 )
198 parameter( ntypes = 9 )
200 parameter( ntests = 8 )
204 CHARACTER dist, type, uplo, xtype
206 INTEGER i, imat, in, inb, info, ioff, irhs, iuplo,
207 $ izero, k, kl, ku, lda, mode, n, nb, nerrs,
208 $ nfail, nimat, nrhs, nrun
209 DOUBLE PRECISION anorm, cndnum, rcond, rcondc
213 INTEGER iseed( 4 ), iseedy( 4 )
214 DOUBLE PRECISION result( ntests )
232 COMMON / infoc / infot, nunit, ok, lerr
233 COMMON / srnamc / srnamt
239 DATA iseedy / 1988, 1989, 1990, 1991 /
240 DATA uplos /
'U',
'L' /
246 path( 1: 1 ) =
'Double precision'
252 iseed( i ) = iseedy( i )
258 $ CALL
derrpo( path, nout )
273 DO 110 imat = 1, nimat
277 IF( .NOT.dotype( imat ) )
282 zerot = imat.GE.3 .AND. imat.LE.5
283 IF( zerot .AND. n.LT.imat-2 )
289 uplo = uplos( iuplo )
294 CALL
dlatb4( path, imat, n, n, type, kl, ku, anorm, mode,
298 CALL
dlatms( n, n, dist, iseed, type, rwork, mode,
299 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
305 CALL
alaerh( path,
'DLATMS', info, 0, uplo, n, n, -1,
306 $ -1, -1, imat, nfail, nerrs, nout )
316 ELSE IF( imat.EQ.4 )
THEN
321 ioff = ( izero-1 )*lda
325 IF( iuplo.EQ.1 )
THEN
326 DO 20 i = 1, izero - 1
336 DO 40 i = 1, izero - 1
357 CALL
dlacpy( uplo, n, n, a, lda, afac, lda )
359 CALL
dpotrf( uplo, n, afac, lda, info )
363 IF( info.NE.izero )
THEN
364 CALL
alaerh( path,
'DPOTRF', info, izero, uplo, n,
365 $ n, -1, -1, nb, imat, nfail, nerrs,
378 CALL
dlacpy( uplo, n, n, afac, lda, ainv, lda )
379 CALL
dpot01( uplo, n, a, lda, ainv, lda, rwork,
385 CALL
dlacpy( uplo, n, n, afac, lda, ainv, lda )
387 CALL
dpotri( uplo, n, ainv, lda, info )
392 $ CALL
alaerh( path,
'DPOTRI', info, 0, uplo, n, n,
393 $ -1, -1, -1, imat, nfail, nerrs, nout )
395 CALL
dpot03( uplo, n, a, lda, ainv, lda, work, lda,
396 $ rwork, rcondc, result( 2 ) )
402 IF( result( k ).GE.thresh )
THEN
403 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
404 $ CALL
alahd( nout, path )
405 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
425 CALL
dlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
426 $ nrhs, a, lda, xact, lda,
b, lda,
428 CALL
dlacpy(
'Full', n, nrhs,
b, lda,
x, lda )
431 CALL
dpotrs( uplo, n, nrhs, afac, lda,
x, lda,
437 $ CALL
alaerh( path,
'DPOTRS', info, 0, uplo, n,
438 $ n, -1, -1, nrhs, imat, nfail,
441 CALL
dlacpy(
'Full', n, nrhs,
b, lda, work, lda )
442 CALL
dpot02( uplo, n, nrhs, a, lda,
x, lda, work,
443 $ lda, rwork, result( 3 ) )
448 CALL
dget04( n, nrhs,
x, lda, xact, lda, rcondc,
455 CALL
dporfs( uplo, n, nrhs, a, lda, afac, lda,
b,
456 $ lda,
x, lda, rwork, rwork( nrhs+1 ),
457 $ work, iwork, info )
462 $ CALL
alaerh( path,
'DPORFS', info, 0, uplo, n,
463 $ n, -1, -1, nrhs, imat, nfail,
466 CALL
dget04( n, nrhs,
x, lda, xact, lda, rcondc,
468 CALL
dpot05( uplo, n, nrhs, a, lda,
b, lda,
x, lda,
469 $ xact, lda, rwork, rwork( nrhs+1 ),
476 IF( result( k ).GE.thresh )
THEN
477 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
478 $ CALL
alahd( nout, path )
479 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
480 $ imat, k, result( k )
490 anorm =
dlansy(
'1', uplo, n, a, lda, rwork )
492 CALL
dpocon( uplo, n, afac, lda, anorm, rcond, work,
498 $ CALL
alaerh( path,
'DPOCON', info, 0, uplo, n, n,
499 $ -1, -1, -1, imat, nfail, nerrs, nout )
501 result( 8 ) =
dget06( rcond, rcondc )
505 IF( result( 8 ).GE.thresh )
THEN
506 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
507 $ CALL
alahd( nout, path )
508 WRITE( nout, fmt = 9997 )uplo, n, imat, 8,
520 CALL
alasum( path, nout, nfail, nrun, nerrs )
522 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
523 $ i2,
', test ', i2,
', ratio =', g12.5 )
524 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
525 $ i2,
', test(', i2,
') =', g12.5 )
526 9997
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
',', 10
x,
' type ', i2,
527 $
', test(', i2,
') =', g12.5 )
subroutine dpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
DPOTRS
subroutine alahd(IOUNIT, PATH)
ALAHD
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 dpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DPOT05
DOUBLE PRECISION function dlansy(NORM, UPLO, N, A, LDA, WORK)
DLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix.
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
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine derrpo(PATH, NUNIT)
DERRPO
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
DOUBLE PRECISION function dget06(RCOND, RCONDC)
DGET06
subroutine dpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
DPOT03
subroutine dporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DPORFS
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
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 dpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
DPOCON
subroutine dpotri(UPLO, N, A, LDA, INFO)
DPOTRI
subroutine dpotrf(UPLO, N, A, LDA, INFO)
DPOTRF
subroutine dchkpo(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
DCHKPO