162 SUBROUTINE dchkpp( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
163 $ nmax, a, afac, ainv, b, x, xact, work, rwork,
173 INTEGER NMAX, NN, NNS, NOUT
174 DOUBLE PRECISION THRESH
178 INTEGER IWORK( * ), NSVAL( * ), NVAL( * )
179 DOUBLE PRECISION A( * ), AFAC( * ), AINV( * ), B( * ),
180 $ rwork( * ), work( * ), x( * ), xact( * )
186 DOUBLE PRECISION ZERO
187 parameter( zero = 0.0d+0 )
189 parameter( ntypes = 9 )
191 parameter( ntests = 8 )
195 CHARACTER DIST, PACKIT,
TYPE, UPLO, XTYPE
197 INTEGER I, IMAT, IN, INFO, IOFF, IRHS, IUPLO, IZERO, K,
198 $ kl, ku, lda, mode, n, nerrs, nfail, nimat, npp,
200 DOUBLE PRECISION ANORM, CNDNUM, RCOND, RCONDC
203 CHARACTER PACKS( 2 ), UPLOS( 2 )
204 INTEGER ISEED( 4 ), ISEEDY( 4 )
205 DOUBLE PRECISION RESULT( ntests )
208 DOUBLE PRECISION DGET06, DLANSP
209 EXTERNAL dget06, dlansp
223 COMMON / infoc / infot, nunit, ok, lerr
224 COMMON / srnamc / srnamt
230 DATA iseedy / 1988, 1989, 1990, 1991 /
231 DATA uplos /
'U',
'L' / , packs /
'C',
'R' /
237 path( 1: 1 ) =
'Double precision'
243 iseed( i ) = iseedy( i )
249 $ CALL
derrpo( path, nout )
262 DO 100 imat = 1, nimat
266 IF( .NOT.dotype( imat ) )
271 zerot = imat.GE.3 .AND. imat.LE.5
272 IF( zerot .AND. n.LT.imat-2 )
278 uplo = uplos( iuplo )
279 packit = packs( iuplo )
284 CALL
dlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
288 CALL
dlatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
289 $ cndnum, anorm, kl, ku, packit, a, lda, work,
295 CALL
alaerh( path,
'DLATMS', info, 0, uplo, n, n, -1,
296 $ -1, -1, imat, nfail, nerrs, nout )
306 ELSE IF( imat.EQ.4 )
THEN
314 IF( iuplo.EQ.1 )
THEN
315 ioff = ( izero-1 )*izero / 2
316 DO 20 i = 1, izero - 1
326 DO 40 i = 1, izero - 1
342 CALL
dcopy( npp, a, 1, afac, 1 )
344 CALL
dpptrf( uplo, n, afac, info )
348 IF( info.NE.izero )
THEN
349 CALL
alaerh( path,
'DPPTRF', info, izero, uplo, n, n,
350 $ -1, -1, -1, imat, nfail, nerrs, nout )
362 CALL
dcopy( npp, afac, 1, ainv, 1 )
363 CALL
dppt01( uplo, n, a, ainv, rwork, result( 1 ) )
368 CALL
dcopy( npp, afac, 1, ainv, 1 )
370 CALL
dpptri( uplo, n, ainv, info )
375 $ CALL
alaerh( path,
'DPPTRI', info, 0, uplo, n, n, -1,
376 $ -1, -1, imat, nfail, nerrs, nout )
378 CALL
dppt03( uplo, n, a, ainv, work, lda, rwork, rcondc,
385 IF( result( k ).GE.thresh )
THEN
386 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
387 $ CALL
alahd( nout, path )
388 WRITE( nout, fmt = 9999 )uplo, n, imat, k,
402 CALL
dlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
403 $ nrhs, a, lda, xact, lda, b, lda, iseed,
405 CALL
dlacpy(
'Full', n, nrhs, b, lda, x, lda )
408 CALL
dpptrs( uplo, n, nrhs, afac, x, lda, info )
413 $ CALL
alaerh( path,
'DPPTRS', info, 0, uplo, n, n,
414 $ -1, -1, nrhs, imat, nfail, nerrs,
417 CALL
dlacpy(
'Full', n, nrhs, b, lda, work, lda )
418 CALL
dppt02( uplo, n, nrhs, a, x, lda, work, lda,
419 $ rwork, result( 3 ) )
424 CALL
dget04( n, nrhs, x, lda, xact, lda, rcondc,
431 CALL
dpprfs( uplo, n, nrhs, a, afac, b, lda, x, lda,
432 $ rwork, rwork( nrhs+1 ), work, iwork,
438 $ CALL
alaerh( path,
'DPPRFS', info, 0, uplo, n, n,
439 $ -1, -1, nrhs, imat, nfail, nerrs,
442 CALL
dget04( n, nrhs, x, lda, xact, lda, rcondc,
444 CALL
dppt05( uplo, n, nrhs, a, b, lda, x, lda, xact,
445 $ lda, rwork, rwork( nrhs+1 ),
452 IF( result( k ).GE.thresh )
THEN
453 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
454 $ CALL
alahd( nout, path )
455 WRITE( nout, fmt = 9998 )uplo, n, nrhs, imat,
466 anorm = dlansp(
'1', uplo, n, a, rwork )
468 CALL
dppcon( uplo, n, afac, anorm, rcond, work, iwork,
474 $ CALL
alaerh( path,
'DPPCON', info, 0, uplo, n, n, -1,
475 $ -1, -1, imat, nfail, nerrs, nout )
477 result( 8 ) = dget06( rcond, rcondc )
481 IF( result( 8 ).GE.thresh )
THEN
482 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
483 $ CALL
alahd( nout, path )
484 WRITE( nout, fmt = 9999 )uplo, n, imat, 8,
495 CALL
alasum( path, nout, nfail, nrun, nerrs )
497 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', type ', i2,
', test ',
498 $ i2,
', ratio =', g12.5 )
499 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
500 $ i2,
', test(', i2,
') =', g12.5 )
subroutine dppt03(UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
DPPT03
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 dcopy(N, DX, INCX, DY, INCY)
DCOPY
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 dppt02(UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
DPPT02
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
subroutine dpptri(UPLO, N, AP, INFO)
DPPTRI
subroutine dpptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
DPPTRS
subroutine derrpo(PATH, NUNIT)
DERRPO
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine dppt01(UPLO, N, A, AFAC, RWORK, RESID)
DPPT01
subroutine dchkpp(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
DCHKPP
subroutine dpptrf(UPLO, N, AP, INFO)
DPPTRF
subroutine dppt05(UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DPPT05
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dppcon(UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO)
DPPCON
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
subroutine dpprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DPPRFS