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( * ), e( * ),
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 = 3 )
186 parameter ( nfact = 2 )
190 CHARACTER dist, fact,
TYPE, uplo, xtype
191 CHARACTER*3 matpath, path
192 INTEGER i, i1, i2, ifact, imat, in, info, ioff, iuplo,
193 $ izero, j, k, kl, ku, lda, lwork, mode, n,
194 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
195 DOUBLE PRECISION ainvnm, anorm, cndnum, rcondc
198 CHARACTER facts( nfact ), uplos( 2 )
199 INTEGER iseed( 4 ), iseedy( 4 )
200 DOUBLE PRECISION result( ntests )
218 COMMON / infoc / infot, nunit, ok, lerr
219 COMMON / srnamc / srnamt
225 DATA iseedy / 1988, 1989, 1990, 1991 /
226 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
234 path( 1: 1 ) =
'Zomplex precision'
239 matpath( 1: 1 ) =
'Zomplex precision'
240 matpath( 2: 3 ) =
'HE'
246 iseed( i ) = iseedy( i )
248 lwork = max( 2*nmax, nmax*nrhs )
253 $
CALL zerrvx( path, nout )
274 DO 170 imat = 1, nimat
278 IF( .NOT.dotype( imat ) )
283 zerot = imat.GE.3 .AND. imat.LE.6
284 IF( zerot .AND. n.LT.imat-2 )
290 uplo = uplos( iuplo )
297 CALL zlatb4( matpath, imat, n, n,
TYPE, kl, ku, anorm,
298 $ mode, cndnum, dist )
303 CALL zlatms( n, n, dist, iseed,
TYPE, rwork, mode,
304 $ cndnum, anorm, kl, ku, uplo, a, lda,
310 CALL alaerh( path,
'ZLATMS', info, 0, uplo, n, n,
311 $ -1, -1, -1, imat, nfail, nerrs, nout )
321 ELSE IF( imat.EQ.4 )
THEN
331 IF( iuplo.EQ.1 )
THEN
332 ioff = ( izero-1 )*lda
333 DO 20 i = 1, izero - 1
343 DO 40 i = 1, izero - 1
353 IF( iuplo.EQ.1 )
THEN
386 DO 150 ifact = 1, nfact
390 fact = facts( ifact )
399 ELSE IF( ifact.EQ.1 )
THEN
403 anorm =
zlanhe(
'1', uplo, n, a, lda, rwork )
408 CALL zlacpy( uplo, n, n, a, lda, afac, lda )
409 CALL zhetrf_rk( uplo, n, afac, lda, e, iwork, work,
414 CALL zlacpy( uplo, n, n, afac, lda, ainv, lda )
415 lwork = (n+nb+1)*(nb+3)
420 CALL zhetri_3( uplo, n, ainv, lda, e, iwork,
421 $ work, lwork, info )
422 ainvnm =
zlanhe(
'1', uplo, n, ainv, lda, rwork )
426 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
429 rcondc = ( one / anorm ) / ainvnm
436 CALL zlarhs( matpath, xtype, uplo,
' ', n, n, kl, ku,
437 $ nrhs, a, lda, xact, lda, b, lda, iseed,
443 IF( ifact.EQ.2 )
THEN
444 CALL zlacpy( uplo, n, n, a, lda, afac, lda )
445 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
451 CALL zhesv_rk( uplo, n, nrhs, afac, lda, e, iwork,
452 $ x, lda, work, lwork, info )
460 IF( iwork( k ).LT.0 )
THEN
461 IF( iwork( k ).NE.-k )
THEN
465 ELSE IF( iwork( k ).NE.k )
THEN
474 CALL alaerh( path,
'ZHESV_RK', info, k, uplo,
475 $ n, n, -1, -1, nrhs, imat, nfail,
478 ELSE IF( info.NE.0 )
THEN
485 CALL zhet01_3( uplo, n, a, lda, afac, lda, e,
486 $ iwork, ainv, lda, rwork,
491 CALL zlacpy(
'Full', n, nrhs, b, lda, work, lda )
492 CALL zpot02( uplo, n, nrhs, a, lda, x, lda, work,
493 $ lda, rwork, result( 2 ) )
498 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
506 IF( result( k ).GE.thresh )
THEN
507 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
508 $
CALL aladhd( nout, path )
509 WRITE( nout, fmt = 9999 )
'ZHESV_RK', uplo,
510 $ n, imat, k, result( k )
526 CALL alasvm( path, nout, nfail, nrun, nerrs )
528 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
529 $
', test ', i2,
', ratio =', g12.5 )
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zhetrf_rk(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
ZHETRF_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch...
subroutine zhesv_rk(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, LWORK, INFO)
ZHESV_RK computes the solution to system of linear equations A * X = B for SY matrices ...
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 zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zhet01_3(UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C, LDC, RWORK, RESID)
ZHET01_3
subroutine zpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZPOT02
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
subroutine zhetri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
ZHETRI_3
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