158 SUBROUTINE zchkpp( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
159 $ nmax, a, afac, ainv, b, x, xact, work, rwork,
169 INTEGER NMAX, NN, NNS, NOUT
170 DOUBLE PRECISION THRESH
174 INTEGER NSVAL( * ), NVAL( * )
175 DOUBLE PRECISION RWORK( * )
176 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
177 $ work( * ), x( * ), xact( * )
183 DOUBLE PRECISION ZERO
184 parameter ( zero = 0.0d+0 )
186 parameter ( ntypes = 9 )
188 parameter ( ntests = 8 )
192 CHARACTER DIST, PACKIT,
TYPE, UPLO, XTYPE
194 INTEGER I, IMAT, IN, INFO, IOFF, IRHS, IUPLO, IZERO, K,
195 $ kl, ku, lda, mode, n, nerrs, nfail, nimat, npp,
197 DOUBLE PRECISION ANORM, CNDNUM, RCOND, RCONDC
200 CHARACTER PACKS( 2 ), UPLOS( 2 )
201 INTEGER ISEED( 4 ), ISEEDY( 4 )
202 DOUBLE PRECISION RESULT( ntests )
205 DOUBLE PRECISION DGET06, ZLANHP
206 EXTERNAL dget06, zlanhp
220 COMMON / infoc / infot, nunit, ok, lerr
221 COMMON / srnamc / srnamt
227 DATA iseedy / 1988, 1989, 1990, 1991 /
228 DATA uplos /
'U',
'L' / , packs /
'C',
'R' /
234 path( 1: 1 ) =
'Zomplex precision'
240 iseed( i ) = iseedy( i )
246 $
CALL zerrpo( path, nout )
259 DO 100 imat = 1, nimat
263 IF( .NOT.dotype( imat ) )
268 zerot = imat.GE.3 .AND. imat.LE.5
269 IF( zerot .AND. n.LT.imat-2 )
275 uplo = uplos( iuplo )
276 packit = packs( iuplo )
281 CALL zlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
285 CALL zlatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
286 $ cndnum, anorm, kl, ku, packit, a, lda, work,
292 CALL alaerh( path,
'ZLATMS', info, 0, uplo, n, n, -1,
293 $ -1, -1, imat, nfail, nerrs, nout )
303 ELSE IF( imat.EQ.4 )
THEN
311 IF( iuplo.EQ.1 )
THEN
312 ioff = ( izero-1 )*izero / 2
313 DO 20 i = 1, izero - 1
323 DO 40 i = 1, izero - 1
338 IF( iuplo.EQ.1 )
THEN
341 CALL zlaipd( n, a, n, -1 )
347 CALL zcopy( npp, a, 1, afac, 1 )
349 CALL zpptrf( uplo, n, afac, info )
353 IF( info.NE.izero )
THEN
354 CALL alaerh( path,
'ZPPTRF', info, izero, uplo, n, n,
355 $ -1, -1, -1, imat, nfail, nerrs, nout )
367 CALL zcopy( npp, afac, 1, ainv, 1 )
368 CALL zppt01( uplo, n, a, ainv, rwork, result( 1 ) )
373 CALL zcopy( npp, afac, 1, ainv, 1 )
375 CALL zpptri( uplo, n, ainv, info )
380 $
CALL alaerh( path,
'ZPPTRI', info, 0, uplo, n, n, -1,
381 $ -1, -1, imat, nfail, nerrs, nout )
383 CALL zppt03( uplo, n, a, ainv, work, lda, rwork, rcondc,
390 IF( result( k ).GE.thresh )
THEN
391 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
392 $
CALL alahd( nout, path )
393 WRITE( nout, fmt = 9999 )uplo, n, imat, k,
407 CALL zlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
408 $ nrhs, a, lda, xact, lda, b, lda, iseed,
410 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
413 CALL zpptrs( uplo, n, nrhs, afac, x, lda, info )
418 $
CALL alaerh( path,
'ZPPTRS', info, 0, uplo, n, n,
419 $ -1, -1, nrhs, imat, nfail, nerrs,
422 CALL zlacpy(
'Full', n, nrhs, b, lda, work, lda )
423 CALL zppt02( uplo, n, nrhs, a, x, lda, work, lda,
424 $ rwork, result( 3 ) )
429 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
436 CALL zpprfs( uplo, n, nrhs, a, afac, b, lda, x, lda,
437 $ rwork, rwork( nrhs+1 ), work,
438 $ rwork( 2*nrhs+1 ), info )
443 $
CALL alaerh( path,
'ZPPRFS', info, 0, uplo, n, n,
444 $ -1, -1, nrhs, imat, nfail, nerrs,
447 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
449 CALL zppt05( uplo, n, nrhs, a, b, lda, x, lda, xact,
450 $ lda, rwork, rwork( nrhs+1 ),
457 IF( result( k ).GE.thresh )
THEN
458 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
459 $
CALL alahd( nout, path )
460 WRITE( nout, fmt = 9998 )uplo, n, nrhs, imat,
471 anorm = zlanhp(
'1', uplo, n, a, rwork )
473 CALL zppcon( uplo, n, afac, anorm, rcond, work, rwork,
479 $
CALL alaerh( path,
'ZPPCON', info, 0, uplo, n, n, -1,
480 $ -1, -1, imat, nfail, nerrs, nout )
482 result( 8 ) = dget06( rcond, rcondc )
486 IF( result( 8 ).GE.thresh )
THEN
487 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
488 $
CALL alahd( nout, path )
489 WRITE( nout, fmt = 9999 )uplo, n, imat, 8,
501 CALL alasum( path, nout, nfail, nrun, nerrs )
503 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', type ', i2,
', test ',
504 $ i2,
', ratio =', g12.5 )
505 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
506 $ i2,
', test(', i2,
') =', g12.5 )
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zerrpo(PATH, NUNIT)
ZERRPO
subroutine zpptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
ZPPTRS
subroutine zpptrf(UPLO, N, AP, INFO)
ZPPTRF
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zpprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZPPRFS
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zppt03(UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZPPT03
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
subroutine zchkpp(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, NOUT)
ZCHKPP
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
subroutine zpptri(UPLO, N, AP, INFO)
ZPPTRI
subroutine zppt02(UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
ZPPT02
subroutine zppt05(UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPPT05
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zppt01(UPLO, N, A, AFAC, RWORK, RESID)
ZPPT01
subroutine zppcon(UPLO, N, AP, ANORM, RCOND, WORK, RWORK, INFO)
ZPPCON
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM