170 SUBROUTINE zchkhe( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
171 $ thresh, tsterr, nmax, a, afac, ainv,
b, x,
172 $ xact, work, rwork, iwork, nout )
181 INTEGER nmax, nn, nnb, nns, nout
182 DOUBLE PRECISION thresh
186 INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
187 DOUBLE PRECISION rwork( * )
188 COMPLEX*16 a( * ), afac( * ), ainv( * ),
b( * ),
189 $ work( * ), x( * ), xact( * )
195 DOUBLE PRECISION zero
196 parameter( zero = 0.0d+0 )
198 parameter( czero = ( 0.0d+0, 0.0d+0 ) )
200 parameter( ntypes = 10 )
202 parameter( ntests = 9 )
205 LOGICAL trfcon, zerot
206 CHARACTER dist, type, uplo, xtype
208 INTEGER i, i1, i2, imat, in, inb, info, ioff, irhs,
209 $ iuplo, izero,
j, k, kl, ku, lda, lwork, mode,
210 $ n, nb, nerrs, nfail, nimat, nrhs, nrun, nt
211 DOUBLE PRECISION anorm, cndnum, rcond, rcondc
215 INTEGER iseed( 4 ), iseedy( 4 )
216 DOUBLE PRECISION result( ntests )
237 COMMON / infoc / infot, nunit, ok, lerr
238 COMMON / srnamc / srnamt
241 DATA iseedy / 1988, 1989, 1990, 1991 /
242 DATA uplos /
'U',
'L' /
248 path( 1: 1 ) =
'Zomplex precision'
254 iseed( i ) = iseedy( i )
260 $ CALL
zerrhe( path, nout )
279 DO 170 imat = 1, nimat
283 IF( .NOT.dotype( imat ) )
288 zerot = imat.GE.3 .AND. imat.LE.6
289 IF( zerot .AND. n.LT.imat-2 )
295 uplo = uplos( iuplo )
300 CALL
zlatb4( path, imat, n, n, type, kl, ku, anorm, mode,
306 CALL
zlatms( n, n, dist, iseed, type, rwork, mode,
307 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
313 CALL
alaerh( path,
'ZLATMS', info, 0, uplo, n, n, -1,
314 $ -1, -1, imat, nfail, nerrs, nout )
327 ELSE IF( imat.EQ.4 )
THEN
337 IF( iuplo.EQ.1 )
THEN
338 ioff = ( izero-1 )*lda
339 DO 20 i = 1, izero - 1
349 DO 40 i = 1, izero - 1
359 IF( iuplo.EQ.1 )
THEN
394 CALL
zlaipd( n, a, lda+1, 0 )
410 CALL
zlacpy( uplo, n, n, a, lda, afac, lda )
417 lwork = max( 2, nb )*lda
419 CALL
zhetrf( uplo, n, afac, lda, iwork, ainv, lwork,
428 IF( iwork( k ).LT.0 )
THEN
429 IF( iwork( k ).NE.-k )
THEN
433 ELSE IF( iwork( k ).NE.k )
THEN
442 $ CALL
alaerh( path,
'ZHETRF', info, k, uplo, n, n,
443 $ -1, -1, nb, imat, nfail, nerrs, nout )
456 CALL
zhet01( uplo, n, a, lda, afac, lda, iwork, ainv,
457 $ lda, rwork, result( 1 ) )
463 IF( inb.EQ.1 .AND. .NOT.trfcon )
THEN
464 CALL
zlacpy( uplo, n, n, afac, lda, ainv, lda )
466 lwork = (n+nb+1)*(nb+3)
467 CALL
zhetri2( uplo, n, ainv, lda, iwork, work,
473 $ CALL
alaerh( path,
'ZHETRI', info, -1, uplo, n,
474 $ n, -1, -1, -1, imat, nfail, nerrs,
480 CALL
zpot03( uplo, n, a, lda, ainv, lda, work, lda,
481 $ rwork, rcondc, result( 2 ) )
489 IF( result( k ).GE.thresh )
THEN
490 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
491 $ CALL
alahd( nout, path )
492 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
524 CALL
zlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
525 $ nrhs, a, lda, xact, lda,
b, lda,
527 CALL
zlacpy(
'Full', n, nrhs,
b, lda, x, lda )
530 CALL
zhetrs( uplo, n, nrhs, afac, lda, iwork, x,
536 $ CALL
alaerh( path,
'ZHETRS', info, 0, uplo, n,
537 $ n, -1, -1, nrhs, imat, nfail,
540 CALL
zlacpy(
'Full', n, nrhs,
b, lda, work, lda )
544 CALL
zpot02( uplo, n, nrhs, a, lda, x, lda, work,
545 $ lda, rwork, result( 3 ) )
554 CALL
zlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
555 $ nrhs, a, lda, xact, lda,
b, lda,
557 CALL
zlacpy(
'Full', n, nrhs,
b, lda, x, lda )
560 CALL
zhetrs2( uplo, n, nrhs, afac, lda, iwork, x,
566 $ CALL
alaerh( path,
'ZHETRS2', info, 0, uplo, n,
567 $ n, -1, -1, nrhs, imat, nfail,
570 CALL
zlacpy(
'Full', n, nrhs,
b, lda, work, lda )
574 CALL
zpot02( uplo, n, nrhs, a, lda, x, lda, work,
575 $ lda, rwork, result( 4 ) )
580 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
587 CALL
zherfs( uplo, n, nrhs, a, lda, afac, lda,
588 $ iwork,
b, lda, x, lda, rwork,
589 $ rwork( nrhs+1 ), work,
590 $ rwork( 2*nrhs+1 ), info )
595 $ CALL
alaerh( path,
'ZHERFS', info, 0, uplo, n,
596 $ n, -1, -1, nrhs, imat, nfail,
599 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
601 CALL
zpot05( uplo, n, nrhs, a, lda,
b, lda, x, lda,
602 $ xact, lda, rwork, rwork( nrhs+1 ),
609 IF( result( k ).GE.thresh )
THEN
610 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
611 $ CALL
alahd( nout, path )
612 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
613 $ imat, k, result( k )
627 anorm =
zlanhe(
'1', uplo, n, a, lda, rwork )
629 CALL
zhecon( uplo, n, afac, lda, iwork, anorm, rcond,
635 $ CALL
alaerh( path,
'ZHECON', info, 0, uplo, n, n,
636 $ -1, -1, -1, imat, nfail, nerrs, nout )
638 result( 9 ) =
dget06( rcond, rcondc )
643 IF( result( 9 ).GE.thresh )
THEN
644 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
645 $ CALL
alahd( nout, path )
646 WRITE( nout, fmt = 9997 )uplo, n, imat, 9,
658 CALL
alasum( path, nout, nfail, nrun, nerrs )
660 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
661 $ i2,
', test ', i2,
', ratio =', g12.5 )
662 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
663 $ i2,
', test(', i2,
') =', g12.5 )
664 9997
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
665 $
', test(', i2,
') =', g12.5 )
subroutine zhecon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON
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 zhetrs2(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO)
ZHETRS2
subroutine zerrhe(PATH, NUNIT)
ZERRHE
subroutine zpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZPOT02
subroutine zchkhe(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZCHKHE
double precision function zlanhe(NORM, UPLO, N, A, LDA, WORK)
ZLANHE 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.
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 alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine zhet01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZHET01
subroutine zpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZPOT03
subroutine zhetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRI2
subroutine zpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPOT05
subroutine zhetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF
double precision function dget06(RCOND, RCONDC)
DGET06
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHERFS
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zhetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4