153 $ nmax, a, afac, ainv,
b, x, xact, work,
154 $ rwork, iwork, nout )
163 INTEGER nmax, nn, nout, nrhs
168 INTEGER iwork( * ), nval( * )
170 COMPLEX a( * ), afac( * ), ainv( * ),
b( * ),
171 $ work( * ), x( * ), xact( * )
178 parameter( one = 1.0e+0, zero = 0.0e+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 REAL ainvnm, anorm, cndnum, rcondc
194 CHARACTER facts( nfact ), uplos( 2 )
195 INTEGER iseed( 4 ), iseedy( 4 )
196 REAL 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 ) =
'Complex precision'
236 matpath( 1: 1 ) =
'Complex precision'
237 matpath( 2: 3 ) =
'HE'
243 iseed( i ) = iseedy( i )
245 lwork = max( 2*nmax, nmax*nrhs )
250 $ CALL
cerrvx( 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
clatb4( matpath, imat, n, n, type, kl, ku, anorm,
295 $ mode, cndnum, dist )
300 CALL
clatms( n, n, dist, iseed, type, rwork, mode,
301 $ cndnum, anorm, kl, ku, uplo, a, lda,
307 CALL
alaerh( path,
'CLATMS', 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 =
clanhe(
'1', uplo, n, a, lda, rwork )
405 CALL
clacpy( uplo, n, n, a, lda, afac, lda )
411 CALL
clacpy( uplo, n, n, afac, lda, ainv, lda )
412 lwork = (n+nb+1)*(nb+3)
415 ainvnm =
clanhe(
'1', uplo, n, ainv, lda, rwork )
419 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
422 rcondc = ( one / anorm ) / ainvnm
429 CALL
clarhs( matpath, xtype, uplo,
' ', n, n, kl, ku,
430 $ nrhs, a, lda, xact, lda,
b, lda, iseed,
436 IF( ifact.EQ.2 )
THEN
437 CALL
clacpy( uplo, n, n, a, lda, afac, lda )
438 CALL
clacpy(
'Full', n, nrhs,
b, lda, x, lda )
443 srnamt =
'CHESV_ROOK'
444 CALL
chesv_rook( uplo, n, nrhs, afac, lda, iwork,
445 $ x, lda, work, lwork, info )
453 IF( iwork( k ).LT.0 )
THEN
454 IF( iwork( k ).NE.-k )
THEN
458 ELSE IF( iwork( k ).NE.k )
THEN
467 CALL
alaerh( path,
'CHESV_ROOK', info, k, uplo,
468 $ n, n, -1, -1, nrhs, imat, nfail,
471 ELSE IF( info.NE.0 )
THEN
479 $ iwork, ainv, lda, rwork,
484 CALL
clacpy(
'Full', n, nrhs,
b, lda, work, lda )
485 CALL
cpot02( uplo, n, nrhs, a, lda, x, lda, work,
486 $ lda, rwork, result( 2 ) )
491 CALL
cget04( n, nrhs, x, lda, xact, lda, rcondc,
499 IF( result( k ).GE.thresh )
THEN
500 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
501 $ CALL
aladhd( nout, path )
502 WRITE( nout, fmt = 9999 )
'CHESV_ROOK', uplo,
503 $ n, imat, k, result( k )
519 CALL
alasvm( path, nout, nfail, nrun, nerrs )
521 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
522 $
', test ', i2,
', ratio =', g12.5 )
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
real function clanhe(NORM, UPLO, N, A, LDA, WORK)
CLANHE 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 alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine chet01_rook(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CHET01_ROOK
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine chesv_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CHESV_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using the ...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine chetrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
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 cerrvx(PATH, NUNIT)
CERRVX
subroutine chetri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
CHETRI_ROOK computes the inverse of HE matrix using the factorization obtained with the bounded Bunch...
subroutine cdrvhe_rook(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
CDRVHE_ROOK
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04