152 SUBROUTINE zdrvhe( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
153 $ a, afac, ainv,
b, x, xact, work, rwork, iwork,
163 INTEGER nmax, nn, nout, nrhs
164 DOUBLE PRECISION thresh
168 INTEGER iwork( * ), nval( * )
169 DOUBLE PRECISION rwork( * )
170 COMPLEX*16 a( * ), afac( * ), ainv( * ),
b( * ),
171 $ work( * ), x( * ), xact( * )
177 DOUBLE PRECISION one, zero
178 parameter( one = 1.0d+0, zero = 0.0d+0 )
179 INTEGER ntypes, ntests
180 parameter( ntypes = 10, ntests = 6 )
182 parameter( nfact = 2 )
186 CHARACTER dist, fact, type, uplo, xtype
188 INTEGER i, i1, i2, ifact, imat, in, info, ioff, iuplo,
189 $ izero,
j, k, k1, kl, ku, lda, lwork, mode, n,
190 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
191 DOUBLE PRECISION ainvnm, anorm, cndnum, rcond, rcondc
194 CHARACTER facts( nfact ), uplos( 2 )
195 INTEGER iseed( 4 ), iseedy( 4 )
196 DOUBLE PRECISION result( ntests )
214 COMMON / infoc / infot, nunit, ok, lerr
215 COMMON / srnamc / srnamt
218 INTRINSIC dcmplx, max, min
221 DATA iseedy / 1988, 1989, 1990, 1991 /
222 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
228 path( 1: 1 ) =
'Zomplex precision'
234 iseed( i ) = iseedy( i )
236 lwork = max( 2*nmax, nmax*nrhs )
241 $ CALL
zerrvx( path, nout )
261 DO 170 imat = 1, nimat
265 IF( .NOT.dotype( imat ) )
270 zerot = imat.GE.3 .AND. imat.LE.6
271 IF( zerot .AND. n.LT.imat-2 )
277 uplo = uplos( iuplo )
282 CALL
zlatb4( path, imat, n, n, type, kl, ku, anorm, mode,
286 CALL
zlatms( n, n, dist, iseed, type, rwork, mode,
287 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
293 CALL
alaerh( path,
'ZLATMS', info, 0, uplo, n, n, -1,
294 $ -1, -1, imat, nfail, nerrs, nout )
304 ELSE IF( imat.EQ.4 )
THEN
314 IF( iuplo.EQ.1 )
THEN
315 ioff = ( izero-1 )*lda
316 DO 20 i = 1, izero - 1
326 DO 40 i = 1, izero - 1
337 IF( iuplo.EQ.1 )
THEN
367 CALL
zlaipd( n, a, lda+1, 0 )
369 DO 150 ifact = 1, nfact
373 fact = facts( ifact )
383 ELSE IF( ifact.EQ.1 )
THEN
387 anorm =
zlanhe(
'1', uplo, n, a, lda, rwork )
391 CALL
zlacpy( uplo, n, n, a, lda, afac, lda )
392 CALL
zhetrf( uplo, n, afac, lda, iwork, work,
397 CALL
zlacpy( uplo, n, n, afac, lda, ainv, lda )
398 lwork = (n+nb+1)*(nb+3)
399 CALL
zhetri2( uplo, n, ainv, lda, iwork, work,
401 ainvnm =
zlanhe(
'1', uplo, n, ainv, lda, rwork )
405 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
408 rcondc = ( one / anorm ) / ainvnm
415 CALL
zlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
416 $ nrhs, a, lda, xact, lda,
b, lda, iseed,
422 IF( ifact.EQ.2 )
THEN
423 CALL
zlacpy( uplo, n, n, a, lda, afac, lda )
424 CALL
zlacpy(
'Full', n, nrhs,
b, lda, x, lda )
429 CALL
zhesv( uplo, n, nrhs, afac, lda, iwork, x,
430 $ lda, work, lwork, info )
438 IF( iwork( k ).LT.0 )
THEN
439 IF( iwork( k ).NE.-k )
THEN
443 ELSE IF( iwork( k ).NE.k )
THEN
452 CALL
alaerh( path,
'ZHESV ', info, k, uplo, n,
453 $ n, -1, -1, nrhs, imat, nfail,
456 ELSE IF( info.NE.0 )
THEN
463 CALL
zhet01( uplo, n, a, lda, afac, lda, iwork,
464 $ ainv, lda, rwork, result( 1 ) )
468 CALL
zlacpy(
'Full', n, nrhs,
b, lda, work, lda )
469 CALL
zpot02( uplo, n, nrhs, a, lda, x, lda, work,
470 $ lda, rwork, result( 2 ) )
474 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
482 IF( result( k ).GE.thresh )
THEN
483 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
484 $ CALL
aladhd( nout, path )
485 WRITE( nout, fmt = 9999 )
'ZHESV ', uplo, n,
486 $ imat, k, result( k )
497 $ CALL
zlaset( uplo, n, n, dcmplx( zero ),
498 $ dcmplx( zero ), afac, lda )
499 CALL
zlaset(
'Full', n, nrhs, dcmplx( zero ),
500 $ dcmplx( zero ), x, lda )
506 CALL
zhesvx( fact, uplo, n, nrhs, a, lda, afac, lda,
507 $ iwork,
b, lda, x, lda, rcond, rwork,
508 $ rwork( nrhs+1 ), work, lwork,
509 $ rwork( 2*nrhs+1 ), info )
517 IF( iwork( k ).LT.0 )
THEN
518 IF( iwork( k ).NE.-k )
THEN
522 ELSE IF( iwork( k ).NE.k )
THEN
531 CALL
alaerh( path,
'ZHESVX', info, k, fact // uplo,
532 $ n, n, -1, -1, nrhs, imat, nfail,
538 IF( ifact.GE.2 )
THEN
543 CALL
zhet01( uplo, n, a, lda, afac, lda, iwork,
544 $ ainv, lda, rwork( 2*nrhs+1 ),
553 CALL
zlacpy(
'Full', n, nrhs,
b, lda, work, lda )
554 CALL
zpot02( uplo, n, nrhs, a, lda, x, lda, work,
555 $ lda, rwork( 2*nrhs+1 ), result( 2 ) )
559 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
564 CALL
zpot05( uplo, n, nrhs, a, lda,
b, lda, x, lda,
565 $ xact, lda, rwork, rwork( nrhs+1 ),
574 result( 6 ) =
dget06( rcond, rcondc )
580 IF( result( k ).GE.thresh )
THEN
581 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
582 $ CALL
aladhd( nout, path )
583 WRITE( nout, fmt = 9998 )
'ZHESVX', fact, uplo,
584 $ n, imat, k, result( k )
598 CALL
alasvm( path, nout, nfail, nrun, nerrs )
600 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
601 $
', test ', i2,
', ratio =', g12.5 )
602 9998
FORMAT( 1x, a,
', FACT=''', a1,
''', UPLO=''', a1,
''', N =', i5,
603 $
', type ', i2,
', test ', i2,
', ratio =', g12.5 )
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 alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
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 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 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
double precision function dget06(RCOND, RCONDC)
DGET06
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine aladhd(IOUNIT, PATH)
ALADHD
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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