156 SUBROUTINE zdrvhe( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
157 $ a, afac, ainv, b, x, xact, work, rwork, iwork,
167 INTEGER NMAX, NN, NOUT, NRHS
168 DOUBLE PRECISION THRESH
172 INTEGER IWORK( * ), NVAL( * )
173 DOUBLE PRECISION RWORK( * )
174 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
175 $ work( * ), x( * ), xact( * )
181 DOUBLE PRECISION ONE, ZERO
182 parameter( one = 1.0d+0, zero = 0.0d+0 )
183 INTEGER NTYPES, NTESTS
184 parameter( ntypes = 10, ntests = 6 )
186 parameter( nfact = 2 )
190 CHARACTER DIST, EQUED, FACT,
TYPE, UPLO, XTYPE
192 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
193 $ izero, j, k, k1, kl, ku, lda, lwork, mode, n,
194 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt,
196 DOUBLE PRECISION AINVNM, ANORM, CNDNUM, RCOND, RCONDC,
200 CHARACTER FACTS( nfact ), UPLOS( 2 )
201 INTEGER ISEED( 4 ), ISEEDY( 4 )
202 DOUBLE PRECISION RESULT( ntests ), BERR( nrhs ),
203 $ errbnds_n( nrhs, 3 ), errbnds_c( nrhs, 3 )
206 DOUBLE PRECISION DGET06, ZLANHE
207 EXTERNAL dget06, zlanhe
221 COMMON / infoc / infot, nunit, ok, lerr
222 COMMON / srnamc / srnamt
225 INTRINSIC dcmplx, max, min
228 DATA iseedy / 1988, 1989, 1990, 1991 /
229 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
241 iseed( i ) = iseedy( i )
243 lwork = max( 2*nmax, nmax*nrhs )
248 $ CALL
zerrvx( path, nout )
268 DO 170 imat = 1, nimat
272 IF( .NOT.dotype( imat ) )
277 zerot = imat.GE.3 .AND. imat.LE.6
278 IF( zerot .AND. n.LT.imat-2 )
284 uplo = uplos( iuplo )
289 CALL
zlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
293 CALL
zlatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
294 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
300 CALL
alaerh( path,
'ZLATMS', info, 0, uplo, n, n, -1,
301 $ -1, -1, imat, nfail, nerrs, nout )
311 ELSE IF( imat.EQ.4 )
THEN
321 IF( iuplo.EQ.1 )
THEN
322 ioff = ( izero-1 )*lda
323 DO 20 i = 1, izero - 1
333 DO 40 i = 1, izero - 1
344 IF( iuplo.EQ.1 )
THEN
374 CALL
zlaipd( n, a, lda+1, 0 )
376 DO 150 ifact = 1, nfact
380 fact = facts( ifact )
390 ELSE IF( ifact.EQ.1 )
THEN
394 anorm = zlanhe(
'1', uplo, n, a, lda, rwork )
398 CALL
zlacpy( uplo, n, n, a, lda, afac, lda )
399 CALL
zhetrf( uplo, n, afac, lda, iwork, work,
404 CALL
zlacpy( uplo, n, n, afac, lda, ainv, lda )
405 lwork = (n+nb+1)*(nb+3)
406 CALL
zhetri2( uplo, n, ainv, lda, iwork, work,
408 ainvnm = zlanhe(
'1', uplo, n, ainv, lda, rwork )
412 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
415 rcondc = ( one / anorm ) / ainvnm
422 CALL
zlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
423 $ nrhs, a, lda, xact, lda, b, lda, iseed,
429 IF( ifact.EQ.2 )
THEN
430 CALL
zlacpy( uplo, n, n, a, lda, afac, lda )
431 CALL
zlacpy(
'Full', n, nrhs, b, lda, x, lda )
436 CALL
zhesv( uplo, n, nrhs, afac, lda, iwork, x,
437 $ lda, work, lwork, info )
445 IF( iwork( k ).LT.0 )
THEN
446 IF( iwork( k ).NE.-k )
THEN
450 ELSE IF( iwork( k ).NE.k )
THEN
459 CALL
alaerh( path,
'ZHESV ', info, k, uplo, n,
460 $ n, -1, -1, nrhs, imat, nfail,
463 ELSE IF( info.NE.0 )
THEN
470 CALL
zhet01( uplo, n, a, lda, afac, lda, iwork,
471 $ ainv, lda, rwork, result( 1 ) )
475 CALL
zlacpy(
'Full', n, nrhs, b, lda, work, lda )
476 CALL
zpot02( uplo, n, nrhs, a, lda, x, lda, work,
477 $ lda, rwork, result( 2 ) )
481 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
489 IF( result( k ).GE.thresh )
THEN
490 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
491 $ CALL
aladhd( nout, path )
492 WRITE( nout, fmt = 9999 )
'ZHESV ', uplo, n,
493 $ imat, k, result( k )
504 $ CALL
zlaset( uplo, n, n, dcmplx( zero ),
505 $ dcmplx( zero ), afac, lda )
506 CALL
zlaset(
'Full', n, nrhs, dcmplx( zero ),
507 $ dcmplx( zero ), x, lda )
513 CALL
zhesvx( fact, uplo, n, nrhs, a, lda, afac, lda,
514 $ iwork, b, lda, x, lda, rcond, rwork,
515 $ rwork( nrhs+1 ), work, lwork,
516 $ rwork( 2*nrhs+1 ), info )
524 IF( iwork( k ).LT.0 )
THEN
525 IF( iwork( k ).NE.-k )
THEN
529 ELSE IF( iwork( k ).NE.k )
THEN
538 CALL
alaerh( path,
'ZHESVX', info, k, fact // uplo,
539 $ n, n, -1, -1, nrhs, imat, nfail,
545 IF( ifact.GE.2 )
THEN
550 CALL
zhet01( uplo, n, a, lda, afac, lda, iwork,
551 $ ainv, lda, rwork( 2*nrhs+1 ),
560 CALL
zlacpy(
'Full', n, nrhs, b, lda, work, lda )
561 CALL
zpot02( uplo, n, nrhs, a, lda, x, lda, work,
562 $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
566 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
571 CALL
zpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
572 $ xact, lda, rwork, rwork( nrhs+1 ),
581 result( 6 ) = dget06( rcond, rcondc )
587 IF( result( k ).GE.thresh )
THEN
588 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
589 $ CALL
aladhd( nout, path )
590 WRITE( nout, fmt = 9998 )
'ZHESVX', fact, uplo,
591 $ n, imat, k, result( k )
602 $ CALL
zlaset( uplo, n, n, cmplx( zero ),
603 $ cmplx( zero ), afac, lda )
604 CALL
zlaset(
'Full', n, nrhs, cmplx( zero ),
605 $ cmplx( zero ), x, lda )
613 CALL
zhesvxx( fact, uplo, n, nrhs, a, lda, afac,
614 $ lda, iwork, equed, work( n+1 ), b, lda, x,
615 $ lda, rcond, rpvgrw_svxx, berr, n_err_bnds,
616 $ errbnds_n, errbnds_c, 0, zero, work,
617 $ rwork(2*nrhs+1), info )
625 IF( iwork( k ).LT.0 )
THEN
626 IF( iwork( k ).NE.-k )
THEN
630 ELSE IF( iwork( k ).NE.k )
THEN
638 IF( info.NE.k .AND. info.LE.n)
THEN
639 CALL
alaerh( path,
'ZHESVXX', info, k,
640 $ fact // uplo, n, n, -1, -1, nrhs, imat, nfail,
646 IF( ifact.GE.2 )
THEN
651 CALL
zhet01( uplo, n, a, lda, afac, lda, iwork,
652 $ ainv, lda, rwork(2*nrhs+1),
661 CALL
zlacpy(
'Full', n, nrhs, b, lda, work, lda )
662 CALL
zpot02( uplo, n, nrhs, a, lda, x, lda, work,
663 $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
668 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
673 CALL
zpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
674 $ xact, lda, rwork, rwork( nrhs+1 ),
683 result( 6 ) = dget06( rcond, rcondc )
689 IF( result( k ).GE.thresh )
THEN
690 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
691 $ CALL
aladhd( nout, path )
692 WRITE( nout, fmt = 9998 )
'ZHESVXX',
693 $ fact, uplo, n, imat, k,
708 CALL
alasvm( path, nout, nfail, nrun, nerrs )
715 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
716 $
', test ', i2,
', ratio =', g12.5 )
717 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N =', i5,
718 $
', type ', i2,
', test ', i2,
', ratio =', g12.5 )
subroutine zebchvxx(THRESH, PATH)
ZEBCHVXX
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 zhesvxx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, EQUED, S, B, LDB, X, LDX, RCOND, RPVGRW, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, INFO)
ZHESVXX computes the solution to system of linear equations A * X = B for HE matrices ...
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine zpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZPOT02
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
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine zhet01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZHET01
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
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine zerrvx(PATH, NUNIT)
ZERRVX
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zhesv(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
ZHESV computes the solution to system of linear equations A * X = B for HE matrices ...
subroutine zdrvhe(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZDRVHE
subroutine zhesvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, RWORK, INFO)
ZHESVX computes the solution to system of linear equations A * X = B for HE matrices ...
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4