171 SUBROUTINE cchkhe_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
189 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
191 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
192 $ work( * ), x( * ), xact( * )
199 parameter ( zero = 0.0e+0 )
201 parameter ( czero = ( 0.0e+0, 0.0e+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
218 INTEGER ISEED( 4 ), ISEEDY( 4 )
219 REAL RESULT( ntests )
223 EXTERNAL dget06, clanhe
232 INTRINSIC REAL, IMAG, MAX, MIN
240 COMMON / infoc / infot, nunit, ok, lerr
241 COMMON / srnamc / srnamt
244 DATA iseedy / 1988, 1989, 1990, 1991 /
245 DATA uplos /
'U',
'L' /
254 path( 1: 1 ) =
'Complex precision'
259 matpath( 1: 1 ) =
'Complex precision'
260 matpath( 2: 3 ) =
'HE'
265 iseed( i ) = iseedy( i )
271 $
CALL cerrhe( path, nout )
283 IF( n .GT. nmax )
THEN
285 WRITE(nout, 9995)
'M ', n, nmax
295 DO 170 imat = 1, nimat
299 IF( .NOT.dotype( imat ) )
304 zerot = imat.GE.3 .AND. imat.LE.6
305 IF( zerot .AND. n.LT.imat-2 )
311 uplo = uplos( iuplo )
316 CALL clatb4( matpath, imat, n, n,
TYPE, KL, KU,
317 $ anorm, mode, cndnum, dist )
322 CALL clatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
323 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
329 CALL alaerh( path,
'CLATMS', info, 0, uplo, n, n, -1,
330 $ -1, -1, imat, nfail, nerrs, nout )
343 ELSE IF( imat.EQ.4 )
THEN
353 IF( iuplo.EQ.1 )
THEN
354 ioff = ( izero-1 )*lda
355 DO 20 i = 1, izero - 1
365 DO 40 i = 1, izero - 1
375 IF( iuplo.EQ.1 )
THEN
411 CALL claipd( n, a, lda+1, 0 )
427 CALL clacpy( uplo, n, n, a, lda, afac, lda )
434 lwork = max( 1, ( nb+1 )*lda )
436 CALL chetrf_aa( uplo, n, afac, lda, iwork, ainv,
442 IF( izero.GT.0 )
THEN
448 ELSE IF( iwork( j ).EQ.k )
THEN
462 CALL alaerh( path,
'CHETRF_AA', info, k, uplo,
463 $ n, n, -1, -1, nb, imat, nfail, nerrs,
470 CALL chet01_aa( uplo, n, a, lda, afac, lda, iwork,
471 $ ainv, lda, rwork, result( 1 ) )
479 IF( result( k ).GE.thresh )
THEN
480 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
481 $
CALL alahd( nout, path )
482 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
507 CALL clarhs( matpath, xtype, uplo,
' ', n, n,
508 $ kl, ku, nrhs, a, lda, xact, lda,
509 $ b, lda, iseed, info )
510 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
513 lwork = max( 1, 3*n-2 )
514 CALL chetrs_aa( uplo, n, nrhs, afac, lda, iwork,
515 $ x, lda, work, lwork, info )
520 CALL alaerh( path,
'CHETRS_AA', info, 0,
521 $ uplo, n, n, -1, -1, nrhs, imat,
522 $ nfail, nerrs, nout )
525 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
529 CALL cpot02( uplo, n, nrhs, a, lda, x, lda, work,
530 $ lda, rwork, result( 2 ) )
536 IF( result( k ).GE.thresh )
THEN
537 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
538 $
CALL alahd( nout, path )
539 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
540 $ imat, k, result( k )
557 CALL alasum( path, nout, nfail, nrun, nerrs )
559 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
560 $ i2,
', test ', i2,
', ratio =', g12.5 )
561 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
562 $ i2,
', test(', i2,
') =', g12.5 )
563 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 clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine claipd(N, A, INDA, VINDA)
CLAIPD
subroutine chetrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CHETRS_AA
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine cherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CHERFS
subroutine zpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZPOT03
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
subroutine cerrhe(PATH, NUNIT)
CERRHE
subroutine cchkhe_aa(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
CCHKHE_AA
subroutine zhecon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine chet01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CHET01_AA
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine zpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPOT05
subroutine chetrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF_AA
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM