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 alahd(IOUNIT, PATH)
ALAHD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zhetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRI2
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHERFS
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
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 zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
subroutine zhet01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZHET01
subroutine zhetrs2(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO)
ZHETRS2
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
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 zlaipd(N, A, INDA, VINDA)
ZLAIPD
subroutine zhetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF
double precision function dget06(RCOND, RCONDC)
DGET06
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 zhetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine zhecon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON