163 SUBROUTINE zchkhp( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
164 $ nmax, a, afac, ainv, b, x, xact, work, rwork,
174 INTEGER NMAX, NN, NNS, NOUT
175 DOUBLE PRECISION THRESH
179 INTEGER IWORK( * ), NSVAL( * ), NVAL( * )
180 DOUBLE PRECISION RWORK( * )
181 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
182 $ work( * ), x( * ), xact( * )
188 DOUBLE PRECISION ZERO
189 parameter ( zero = 0.0d+0 )
191 parameter ( ntypes = 10 )
193 parameter ( ntests = 8 )
196 LOGICAL TRFCON, ZEROT
197 CHARACTER DIST, PACKIT,
TYPE, UPLO, XTYPE
199 INTEGER I, I1, I2, IMAT, IN, INFO, IOFF, IRHS, IUPLO,
200 $ izero, j, k, kl, ku, lda, mode, n, nerrs,
201 $ nfail, nimat, npp, nrhs, nrun, nt
202 DOUBLE PRECISION ANORM, CNDNUM, RCOND, RCONDC
206 INTEGER ISEED( 4 ), ISEEDY( 4 )
207 DOUBLE PRECISION RESULT( ntests )
211 DOUBLE PRECISION DGET06, ZLANHP
212 EXTERNAL lsame, dget06, zlanhp
229 COMMON / infoc / infot, nunit, ok, lerr
230 COMMON / srnamc / srnamt
233 DATA iseedy / 1988, 1989, 1990, 1991 /
234 DATA uplos /
'U',
'L' /
240 path( 1: 1 ) =
'Zomplex precision'
246 iseed( i ) = iseedy( i )
252 $
CALL zerrsy( path, nout )
266 DO 160 imat = 1, nimat
270 IF( .NOT.dotype( imat ) )
275 zerot = imat.GE.3 .AND. imat.LE.6
276 IF( zerot .AND. n.LT.imat-2 )
282 uplo = uplos( iuplo )
283 IF( lsame( uplo,
'U' ) )
THEN
292 CALL zlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
296 CALL zlatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
297 $ cndnum, anorm, kl, ku, packit, a, lda, work,
303 CALL alaerh( path,
'ZLATMS', info, 0, uplo, n, n, -1,
304 $ -1, -1, imat, nfail, nerrs, nout )
314 ELSE IF( imat.EQ.4 )
THEN
324 IF( iuplo.EQ.1 )
THEN
325 ioff = ( izero-1 )*izero / 2
326 DO 20 i = 1, izero - 1
336 DO 40 i = 1, izero - 1
347 IF( iuplo.EQ.1 )
THEN
377 IF( iuplo.EQ.1 )
THEN
380 CALL zlaipd( n, a, n, -1 )
386 CALL zcopy( npp, a, 1, afac, 1 )
388 CALL zhptrf( uplo, n, afac, iwork, info )
396 IF( iwork( k ).LT.0 )
THEN
397 IF( iwork( k ).NE.-k )
THEN
401 ELSE IF( iwork( k ).NE.k )
THEN
410 $
CALL alaerh( path,
'ZHPTRF', info, k, uplo, n, n, -1,
411 $ -1, -1, imat, nfail, nerrs, nout )
421 CALL zhpt01( uplo, n, a, afac, iwork, ainv, lda, rwork,
428 IF( .NOT.trfcon )
THEN
429 CALL zcopy( npp, afac, 1, ainv, 1 )
431 CALL zhptri( uplo, n, ainv, iwork, work, info )
436 $
CALL alaerh( path,
'ZHPTRI', info, 0, uplo, n, n,
437 $ -1, -1, -1, imat, nfail, nerrs, nout )
439 CALL zppt03( uplo, n, a, ainv, work, lda, rwork,
440 $ rcondc, result( 2 ) )
448 IF( result( k ).GE.thresh )
THEN
449 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
450 $
CALL alahd( nout, path )
451 WRITE( nout, fmt = 9999 )uplo, n, imat, k,
472 CALL zlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
473 $ nrhs, a, lda, xact, lda, b, lda, iseed,
476 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
479 CALL zhptrs( uplo, n, nrhs, afac, iwork, x, lda,
485 $
CALL alaerh( path,
'ZHPTRS', info, 0, uplo, n, n,
486 $ -1, -1, nrhs, imat, nfail, nerrs,
489 CALL zlacpy(
'Full', n, nrhs, b, lda, work, lda )
490 CALL zppt02( uplo, n, nrhs, a, x, lda, work, lda,
491 $ rwork, result( 3 ) )
496 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
503 CALL zhprfs( uplo, n, nrhs, a, afac, iwork, b, lda, x,
504 $ lda, rwork, rwork( nrhs+1 ), work,
505 $ rwork( 2*nrhs+1 ), info )
510 $
CALL alaerh( path,
'ZHPRFS', info, 0, uplo, n, n,
511 $ -1, -1, nrhs, imat, nfail, nerrs,
514 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
516 CALL zppt05( uplo, n, nrhs, a, b, lda, x, lda, xact,
517 $ lda, rwork, rwork( nrhs+1 ),
524 IF( result( k ).GE.thresh )
THEN
525 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
526 $
CALL alahd( nout, path )
527 WRITE( nout, fmt = 9998 )uplo, n, nrhs, imat,
539 anorm = zlanhp(
'1', uplo, n, a, rwork )
541 CALL zhpcon( uplo, n, afac, iwork, anorm, rcond, work,
547 $
CALL alaerh( path,
'ZHPCON', info, 0, uplo, n, n, -1,
548 $ -1, -1, imat, nfail, nerrs, nout )
550 result( 8 ) = dget06( rcond, rcondc )
554 IF( result( 8 ).GE.thresh )
THEN
555 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
556 $
CALL alahd( nout, path )
557 WRITE( nout, fmt = 9999 )uplo, n, imat, 8,
568 CALL alasum( path, nout, nfail, nrun, nerrs )
570 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', type ', i2,
', test ',
571 $ i2,
', ratio =', g12.5 )
572 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
573 $ 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 zerrsy(PATH, NUNIT)
ZERRSY
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zhprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHPRFS
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 zhpcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
ZHPCON
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 zlaipd(N, A, INDA, VINDA)
ZLAIPD
subroutine zhptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
ZHPTRS
subroutine zppt02(UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
ZPPT02
subroutine zhpt01(UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
ZHPT01
subroutine zhptri(UPLO, N, AP, IPIV, WORK, INFO)
ZHPTRI
subroutine zhptrf(UPLO, N, AP, IPIV, INFO)
ZHPTRF
subroutine zppt05(UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPPT05
subroutine zchkhp(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZCHKHP
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM