171 SUBROUTINE zchkhe_aa( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
172 $ thresh, tsterr, nmax, a, afac, ainv, b,
173 $ x, xact, work, rwork, iwork, nout )
184 INTEGER NMAX, NN, NNB, NNS, NOUT
185 DOUBLE PRECISION THRESH
189 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
190 DOUBLE PRECISION RWORK( * )
191 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
192 $ work( * ), x( * ), xact( * )
198 DOUBLE PRECISION ZERO
199 parameter ( zero = 0.0d+0 )
201 parameter ( czero = ( 0.0d+0, 0.0d+0 ) )
203 parameter ( ntypes = 10 )
205 parameter ( ntests = 9 )
209 CHARACTER DIST,
TYPE, UPLO, XTYPE
210 CHARACTER*3 PATH, MATPATH
211 INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
212 $ iuplo, izero, j, k, kl, ku, lda, lwork, mode,
213 $ n, nb, nerrs, nfail, nimat, nrhs, nrun, nt
214 DOUBLE PRECISION ANORM, CNDNUM
218 INTEGER ISEED( 4 ), ISEEDY( 4 )
219 DOUBLE PRECISION RESULT( ntests )
222 DOUBLE PRECISION DGET06, ZLANHE
223 EXTERNAL dget06, zlanhe
240 COMMON / infoc / infot, nunit, ok, lerr
241 COMMON / srnamc / srnamt
244 DATA iseedy / 1988, 1989, 1990, 1991 /
245 DATA uplos /
'U',
'L' /
253 path( 1: 1 ) =
'Zomplex precision'
258 matpath( 1: 1 ) =
'Zomplex precision'
259 matpath( 2: 3 ) =
'HE'
264 iseed( i ) = iseedy( i )
270 $
CALL zerrhe( path, nout )
282 IF( n .GT. nmax )
THEN
284 WRITE(nout, 9995)
'M ', n, nmax
294 DO 170 imat = 1, nimat
298 IF( .NOT.dotype( imat ) )
303 zerot = imat.GE.3 .AND. imat.LE.6
304 IF( zerot .AND. n.LT.imat-2 )
310 uplo = uplos( iuplo )
315 CALL zlatb4( matpath, imat, n, n,
TYPE, KL, KU,
316 $ anorm, mode, cndnum, dist )
321 CALL zlatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
322 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
328 CALL alaerh( path,
'ZLATMS', info, 0, uplo, n, n, -1,
329 $ -1, -1, imat, nfail, nerrs, nout )
342 ELSE IF( imat.EQ.4 )
THEN
352 IF( iuplo.EQ.1 )
THEN
353 ioff = ( izero-1 )*lda
354 DO 20 i = 1, izero - 1
364 DO 40 i = 1, izero - 1
374 IF( iuplo.EQ.1 )
THEN
410 CALL zlaipd( n, a, lda+1, 0 )
426 CALL zlacpy( uplo, n, n, a, lda, afac, lda )
433 lwork = max( 1, ( nb+1 )*lda )
435 CALL zhetrf_aa( uplo, n, afac, lda, iwork, ainv,
441 IF( izero.GT.0 )
THEN
447 ELSE IF( iwork( j ).EQ.k )
THEN
461 CALL alaerh( path,
'ZHETRF_AA', info, k, uplo,
462 $ n, n, -1, -1, nb, imat, nfail, nerrs,
469 CALL zhet01_aa( uplo, n, a, lda, afac, lda, iwork,
470 $ ainv, lda, rwork, result( 1 ) )
478 IF( result( k ).GE.thresh )
THEN
479 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
480 $
CALL alahd( nout, path )
481 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
506 CALL zlarhs( matpath, xtype, uplo,
' ', n, n,
507 $ kl, ku, nrhs, a, lda, xact, lda,
508 $ b, lda, iseed, info )
509 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
512 lwork = max( 1, 3*n-2 )
513 CALL zhetrs_aa( uplo, n, nrhs, afac, lda, iwork,
514 $ x, lda, work, lwork, info )
519 CALL alaerh( path,
'ZHETRS', info, 0, uplo, n,
520 $ n, -1, -1, nrhs, imat, nfail,
524 CALL zlacpy(
'Full', n, nrhs, b, lda, work, lda )
528 CALL zpot02( uplo, n, nrhs, a, lda, x, lda, work,
529 $ lda, rwork, result( 2 ) )
535 IF( result( k ).GE.thresh )
THEN
536 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
537 $
CALL alahd( nout, path )
538 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
539 $ imat, k, result( k )
556 CALL alasum( path, nout, nfail, nrun, nerrs )
558 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
559 $ i2,
', test ', i2,
', ratio =', g12.5 )
560 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
561 $ i2,
', test(', i2,
') =', g12.5 )
564 9995
FORMAT(
' Invalid input value: ', a4,
'=', i6,
'; must be <=',
subroutine zhetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRI2
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zerrhe(PATH, NUNIT)
ZERRHE
subroutine zpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZPOT02
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 xlaenv(ISPEC, NVALUE)
XLAENV
subroutine zchkhe_aa(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZCHKHE_AA
subroutine zpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZPOT03
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
subroutine zhecon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
subroutine zhetrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
ZHETRS_AA
subroutine zherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHERFS
subroutine zhetrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF_AA
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPOT05
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine zhet01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZHET01_AA