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 zppt03(UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZPPT03
subroutine zppt01(UPLO, N, A, AFAC, RWORK, RESID)
ZPPT01
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zpptri(UPLO, N, AP, INFO)
ZPPTRI
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zpptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
ZPPTRS
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zpptrf(UPLO, N, AP, INFO)
ZPPTRF
subroutine zpprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZPPRFS
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine zerrpo(PATH, NUNIT)
ZERRPO
subroutine zppt05(UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPPT05
subroutine zppt02(UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
ZPPT02
subroutine zppcon(UPLO, N, AP, ANORM, RCOND, WORK, RWORK, INFO)
ZPPCON
subroutine zchkpp(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, NOUT)
ZCHKPP
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4