152 SUBROUTINE cdrvhe_aa( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
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
194 CHARACTER FACTS( nfact ), UPLOS( 2 )
195 INTEGER ISEED( 4 ), ISEEDY( 4 )
196 REAL RESULT( ntests )
200 EXTERNAL clanhe, sget06
214 COMMON / infoc / infot, nunit, ok, lerr
215 COMMON / srnamc / srnamt
218 INTRINSIC cmplx, max, min
221 DATA iseedy / 1988, 1989, 1990, 1991 /
222 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
230 path( 1: 1 ) =
'Complex precision'
235 matpath( 1: 1 ) =
'Complex precision'
236 matpath( 2: 3 ) =
'HE'
242 iseed( i ) = iseedy( i )
244 lwork = max( 2*nmax, nmax*nrhs )
249 $
CALL cerrvx( path, nout )
269 DO 170 imat = 1, nimat
273 IF( .NOT.dotype( imat ) )
278 zerot = imat.GE.3 .AND. imat.LE.6
279 IF( zerot .AND. n.LT.imat-2 )
285 uplo = uplos( iuplo )
292 CALL clatb4( matpath, imat, n, n,
TYPE, KL, KU, ANORM,
293 $ mode, cndnum, dist )
298 CALL clatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
299 $ cndnum, anorm, kl, ku, uplo, a, lda,
305 CALL alaerh( path,
'CLATMS', info, 0, uplo, n, n,
306 $ -1, -1, -1, imat, nfail, nerrs, nout )
316 ELSE IF( imat.EQ.4 )
THEN
326 IF( iuplo.EQ.1 )
THEN
327 ioff = ( izero-1 )*lda
328 DO 20 i = 1, izero - 1
338 DO 40 i = 1, izero - 1
349 IF( iuplo.EQ.1 )
THEN
382 DO 150 ifact = 1, nfact
386 fact = facts( ifact )
391 CALL clarhs( matpath, xtype, uplo,
' ', n, n, kl, ku,
392 $ nrhs, a, lda, xact, lda, b, lda, iseed,
398 IF( ifact.EQ.2 )
THEN
399 CALL clacpy( uplo, n, n, a, lda, afac, lda )
400 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
405 CALL chesv_aa( uplo, n, nrhs, afac, lda, iwork,
406 $ x, lda, work, lwork, info )
411 IF( izero.GT.0 )
THEN
417 ELSE IF( iwork( j ).EQ.k )
THEN
431 CALL alaerh( path,
'CHESV_AA', info, k,
432 $ uplo, n, n, -1, -1, nrhs,
433 $ imat, nfail, nerrs, nout )
435 ELSE IF( info.NE.0 )
THEN
442 CALL chet01_aa( uplo, n, a, lda, afac, lda,
443 $ iwork, ainv, lda, rwork,
448 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
449 CALL cpot02( uplo, n, nrhs, a, lda, x, lda, work,
450 $ lda, rwork, result( 2 ) )
457 IF( result( k ).GE.thresh )
THEN
458 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
459 $
CALL aladhd( nout, path )
460 WRITE( nout, fmt = 9999 )
'CHESV_AA ',
461 $ uplo, n, imat, k, result( k )
477 CALL alasvm( path, nout, nfail, nrun, nerrs )
479 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
480 $
', 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 clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine cerrvx(PATH, NUNIT)
CERRVX
subroutine cdrvhe_aa(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
CDRVHE_AA
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine chet01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CHET01_AA
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine chetrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF_AA
subroutine chesv_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CHESV_AA computes the solution to system of linear equations A * X = B for HE matrices ...
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04