155 SUBROUTINE zdrvhe_rk( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR,
156 $ NMAX, A, AFAC, E, AINV, B, X, XACT, WORK,
157 $ RWORK, IWORK, NOUT )
165 INTEGER NMAX, NN, NOUT, NRHS
166 DOUBLE PRECISION THRESH
170 INTEGER IWORK( * ), NVAL( * )
171 DOUBLE PRECISION RWORK( * )
172 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ), E( * ),
173 $ work( * ), x( * ), xact( * )
179 DOUBLE PRECISION ONE, ZERO
180 PARAMETER ( ONE = 1.0d+0, zero = 0.0d+0 )
181 INTEGER NTYPES, NTESTS
182 parameter( ntypes = 10, ntests = 3 )
184 parameter( nfact = 2 )
188 CHARACTER DIST, FACT,
TYPE, UPLO, XTYPE
189 CHARACTER*3 MATPATH, PATH
190 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
191 $ izero, j, k, kl, ku, lda, lwork, mode, n,
192 $ nb, nbmin, nerrs, nfail, nimat, nrun, nt
193 DOUBLE PRECISION AINVNM, ANORM, CNDNUM, RCONDC
196 CHARACTER FACTS( NFACT ), UPLOS( 2 )
197 INTEGER ISEED( 4 ), ISEEDY( 4 )
198 DOUBLE PRECISION RESULT( NTESTS )
202 DOUBLE PRECISION ZLANHE
216 COMMON / infoc / infot, nunit, ok, lerr
217 COMMON / srnamc / srnamt
223 DATA iseedy / 1988, 1989, 1990, 1991 /
224 DATA uplos /
'U',
'L' / , facts /
'F',
'N' /
232 path( 1: 1 ) =
'Zomplex precision'
237 matpath( 1: 1 ) =
'Zomplex precision'
238 matpath( 2: 3 ) =
'HE'
244 iseed( i ) = iseedy( i )
246 lwork = max( 2*nmax, nmax*nrhs )
251 $
CALL zerrvx( path, nout )
272 DO 170 imat = 1, nimat
276 IF( .NOT.dotype( imat ) )
281 zerot = imat.GE.3 .AND. imat.LE.6
282 IF( zerot .AND. n.LT.imat-2 )
288 uplo = uplos( iuplo )
295 CALL zlatb4( matpath, imat, n, n,
TYPE, kl, ku, anorm,
296 $ mode, cndnum, dist )
301 CALL zlatms( n, n, dist, iseed,
TYPE, rwork, mode,
302 $ cndnum, anorm, kl, ku, uplo, a, lda,
308 CALL alaerh( path,
'ZLATMS', info, 0, uplo, n, n,
309 $ -1, -1, -1, imat, nfail, nerrs, nout )
319 ELSE IF( imat.EQ.4 )
THEN
329 IF( iuplo.EQ.1 )
THEN
330 ioff = ( izero-1 )*lda
331 DO 20 i = 1, izero - 1
341 DO 40 i = 1, izero - 1
351 IF( iuplo.EQ.1 )
THEN
384 DO 150 ifact = 1, nfact
388 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 )
407 CALL zhetrf_rk( uplo, n, afac, lda, e, iwork, work,
412 CALL zlacpy( uplo, n, n, afac, lda, ainv, lda )
413 lwork = (n+nb+1)*(nb+3)
418 CALL zhetri_3( uplo, n, ainv, lda, e, iwork,
419 $ work, lwork, info )
420 ainvnm = zlanhe(
'1', uplo, n, ainv, lda, rwork )
424 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
427 rcondc = ( one / anorm ) / ainvnm
434 CALL zlarhs( matpath, xtype, uplo,
' ', n, n, kl, ku,
435 $ nrhs, a, lda, xact, lda, b, lda, iseed,
441 IF( ifact.EQ.2 )
THEN
442 CALL zlacpy( uplo, n, n, a, lda, afac, lda )
443 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
449 CALL zhesv_rk( uplo, n, nrhs, afac, lda, e, iwork,
450 $ x, lda, work, lwork, info )
458 IF( iwork( k ).LT.0 )
THEN
459 IF( iwork( k ).NE.-k )
THEN
463 ELSE IF( iwork( k ).NE.k )
THEN
472 CALL alaerh( path,
'ZHESV_RK', info, k, uplo,
473 $ n, n, -1, -1, nrhs, imat, nfail,
476 ELSE IF( info.NE.0 )
THEN
483 CALL zhet01_3( uplo, n, a, lda, afac, lda, e,
484 $ iwork, ainv, lda, rwork,
489 CALL zlacpy(
'Full', n, nrhs, b, lda, work, lda )
490 CALL zpot02( uplo, n, nrhs, a, lda, x, lda, work,
491 $ lda, rwork, result( 2 ) )
496 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
504 IF( result( k ).GE.thresh )
THEN
505 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
506 $
CALL aladhd( nout, path )
507 WRITE( nout, fmt = 9999 )
'ZHESV_RK', uplo,
508 $ n, imat, k, result( k )
524 CALL alasvm( path, nout, nfail, nrun, nerrs )
526 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', type ', i2,
527 $
', test ', i2,
', ratio =', g12.5 )