157 SUBROUTINE cdrvhe_rk( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
158 $ nmax, a, afac, e, ainv, b, x, xact, work,
159 $ rwork, iwork, nout )
168 INTEGER NMAX, NN, NOUT, NRHS
173 INTEGER IWORK( * ), NVAL( * )
175 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
176 $ work( * ), x( * ), xact( * )
183 parameter ( one = 1.0e+0, zero = 0.0e+0 )
184 INTEGER NTYPES, NTESTS
185 parameter ( ntypes = 10, ntests = 3 )
187 parameter ( nfact = 2 )
191 CHARACTER DIST, FACT,
TYPE, UPLO, XTYPE
192 CHARACTER*3 MATPATH, PATH
193 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
194 $ izero, j, k, kl, ku, lda, lwork, mode, n,
195 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
196 REAL AINVNM, ANORM, CNDNUM, RCONDC
199 CHARACTER FACTS( nfact ), UPLOS( 2 )
200 INTEGER ISEED( 4 ), ISEEDY( 4 )
201 REAL RESULT( ntests )
219 COMMON / infoc / infot, nunit, ok, lerr
220 COMMON / srnamc / srnamt
226 DATA iseedy / 1988, 1989, 1990, 1991 /
227 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
235 path( 1: 1 ) =
'Complex precision'
240 matpath( 1: 1 ) =
'Complex precision'
241 matpath( 2: 3 ) =
'HE'
247 iseed( i ) = iseedy( i )
249 lwork = max( 2*nmax, nmax*nrhs )
254 $
CALL cerrvx( path, nout )
275 DO 170 imat = 1, nimat
279 IF( .NOT.dotype( imat ) )
284 zerot = imat.GE.3 .AND. imat.LE.6
285 IF( zerot .AND. n.LT.imat-2 )
291 uplo = uplos( iuplo )
298 CALL clatb4( matpath, imat, n, n,
TYPE, KL, KU, ANORM,
299 $ mode, cndnum, dist )
304 CALL clatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
305 $ cndnum, anorm, kl, ku, uplo, a, lda,
311 CALL alaerh( path,
'CLATMS', info, 0, uplo, n, n,
312 $ -1, -1, -1, imat, nfail, nerrs, nout )
322 ELSE IF( imat.EQ.4 )
THEN
332 IF( iuplo.EQ.1 )
THEN
333 ioff = ( izero-1 )*lda
334 DO 20 i = 1, izero - 1
344 DO 40 i = 1, izero - 1
354 IF( iuplo.EQ.1 )
THEN
387 DO 150 ifact = 1, nfact
391 fact = facts( ifact )
400 ELSE IF( ifact.EQ.1 )
THEN
404 anorm = clanhe(
'1', uplo, n, a, lda, rwork )
408 CALL clacpy( uplo, n, n, a, lda, afac, lda )
409 CALL chetrf_rk( uplo, n, afac, lda, e, iwork, work,
414 CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
415 lwork = (n+nb+1)*(nb+3)
420 CALL csytri_3( uplo, n, ainv, lda, e, iwork,
421 $ work, lwork, info )
422 ainvnm = clanhe(
'1', uplo, n, ainv, lda, rwork )
426 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
429 rcondc = ( one / anorm ) / ainvnm
436 CALL clarhs( matpath, xtype, uplo,
' ', n, n, kl, ku,
437 $ nrhs, a, lda, xact, lda, b, lda, iseed,
443 IF( ifact.EQ.2 )
THEN
444 CALL clacpy( uplo, n, n, a, lda, afac, lda )
445 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
451 CALL chesv_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,
'CHESV_RK', info, k, uplo,
475 $ n, n, -1, -1, nrhs, imat, nfail,
478 ELSE IF( info.NE.0 )
THEN
485 CALL chet01_3( uplo, n, a, lda, afac, lda, e,
486 $ iwork, ainv, lda, rwork,
491 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
492 CALL cpot02( uplo, n, nrhs, a, lda, x, lda, work,
493 $ lda, rwork, result( 2 ) )
498 CALL cget04( 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 )
'CHESV_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 clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine cdrvhe_rk(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, E, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
CDRVHE_RK
subroutine cerrvx(PATH, NUNIT)
CERRVX
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
subroutine chetri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
CHETRI_3
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_3(UPLO, N, A, LDA, AFAC, LDAFAC, E, IPIV, C, LDC, RWORK, RESID)
CHET01_3
subroutine csytri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
CSYTRI_3
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine chetrf_rk(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
CHETRF_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch...
subroutine chesv_rk(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK, LWORK, INFO)
CHESV_RK computes the solution to system of linear equations A * X = B for SY matrices ...
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04