153 $ nmax, a, afac, ainv,
b,
x, xact, work,
154 $ rwork, iwork, nout )
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 = 3 )
182 parameter( nfact = 2 )
186 CHARACTER dist, fact, type, uplo, xtype
187 CHARACTER*3 matpath, path
188 INTEGER i, i1, i2, ifact, imat, in, info, ioff, iuplo,
189 $ izero,
j, k, kl, ku, lda, lwork, mode, n,
190 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
191 DOUBLE PRECISION ainvnm, anorm, cndnum, rcondc
194 CHARACTER facts( nfact ), uplos( 2 )
195 INTEGER iseed( 4 ), iseedy( 4 )
196 DOUBLE PRECISION result( ntests )
215 COMMON / infoc / infot, nunit, ok, lerr
216 COMMON / srnamc / srnamt
222 DATA iseedy / 1988, 1989, 1990, 1991 /
223 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
231 path( 1: 1 ) =
'Zomplex precision'
236 matpath( 1: 1 ) =
'Zomplex precision'
237 matpath( 2: 3 ) =
'HE'
243 iseed( i ) = iseedy( i )
245 lwork = max( 2*nmax, nmax*nrhs )
250 $ CALL
zerrvx( path, nout )
271 DO 170 imat = 1, nimat
275 IF( .NOT.dotype( imat ) )
280 zerot = imat.GE.3 .AND. imat.LE.6
281 IF( zerot .AND. n.LT.imat-2 )
287 uplo = uplos( iuplo )
294 CALL
zlatb4( matpath, imat, n, n, type, kl, ku, anorm,
295 $ mode, cndnum, dist )
300 CALL
zlatms( n, n, dist, iseed, type, rwork, mode,
301 $ cndnum, anorm, kl, ku, uplo, a, lda,
307 CALL
alaerh( path,
'ZLATMS', info, 0, uplo, n, n,
308 $ -1, -1, -1, imat, nfail, nerrs, nout )
318 ELSE IF( imat.EQ.4 )
THEN
328 IF( iuplo.EQ.1 )
THEN
329 ioff = ( izero-1 )*lda
330 DO 20 i = 1, izero - 1
340 DO 40 i = 1, izero - 1
350 IF( iuplo.EQ.1 )
THEN
383 DO 150 ifact = 1, nfact
387 fact = facts( ifact )
397 ELSE IF( ifact.EQ.1 )
THEN
401 anorm =
zlanhe(
'1', uplo, n, a, lda, rwork )
406 CALL
zlacpy( uplo, n, n, a, lda, afac, lda )
412 CALL
zlacpy( uplo, n, n, afac, lda, ainv, lda )
413 lwork = (n+nb+1)*(nb+3)
416 ainvnm =
zlanhe(
'1', uplo, n, ainv, lda, rwork )
420 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
423 rcondc = ( one / anorm ) / ainvnm
430 CALL
zlarhs( matpath, xtype, uplo,
' ', n, n, kl, ku,
431 $ nrhs, a, lda, xact, lda,
b, lda, iseed,
437 IF( ifact.EQ.2 )
THEN
438 CALL
zlacpy( uplo, n, n, a, lda, afac, lda )
439 CALL
zlacpy(
'Full', n, nrhs,
b, lda,
x, lda )
444 srnamt =
'ZHESV_ROOK'
445 CALL
zhesv_rook( uplo, n, nrhs, afac, lda, iwork,
446 $
x, lda, work, lwork, info )
454 IF( iwork( k ).LT.0 )
THEN
455 IF( iwork( k ).NE.-k )
THEN
459 ELSE IF( iwork( k ).NE.k )
THEN
468 CALL
alaerh( path,
'ZHESV_ROOK', info, k, uplo,
469 $ n, n, -1, -1, nrhs, imat, nfail,
472 ELSE IF( info.NE.0 )
THEN
480 $ iwork, ainv, lda, rwork,
485 CALL
zlacpy(
'Full', n, nrhs,
b, lda, work, lda )
486 CALL
zpot02( uplo, n, nrhs, a, lda,
x, lda, work,
487 $ lda, rwork, result( 2 ) )
492 CALL
zget04( n, nrhs,
x, lda, xact, lda, rcondc,
500 IF( result( k ).GE.thresh )
THEN
501 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
502 $ CALL
aladhd( nout, path )
503 WRITE( nout, fmt = 9999 )
'ZHESV_ROOK', uplo,
504 $ n, imat, k, result( k )
520 CALL
alasvm( path, nout, nfail, nrun, nerrs )
522 9999
FORMAT( 1
x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
523 $
', test ', i2,
', ratio =', g12.5 )
subroutine zdrvhe_rook(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZDRVHE_ROOK
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
subroutine zhesv_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
ZHESV_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using the ...
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zhetri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
ZHETRI_ROOK computes the inverse of HE matrix using the factorization obtained with the bounded Bunch...
subroutine zhet01_rook(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZHET01_ROOK
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 zhetrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
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 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 zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4