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 )
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 zppt03(UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZPPT03
LOGICAL function lsame(CA, CB)
LSAME
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 zerrsy(PATH, NUNIT)
ZERRSY
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zhptrf(UPLO, N, AP, IPIV, INFO)
ZHPTRF
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
DOUBLE PRECISION function dget06(RCOND, RCONDC)
DGET06
subroutine zhprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHPRFS
subroutine zhpcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
ZHPCON
DOUBLE PRECISION function zlanhp(NORM, UPLO, N, AP, WORK)
ZLANHP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix supplied in packed form.
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
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zchkhp(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZCHKHP
subroutine zhptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
ZHPTRS
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zhptri(UPLO, N, AP, IPIV, WORK, INFO)
ZHPTRI
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
subroutine zhpt01(UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
ZHPT01
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4