170 SUBROUTINE zchkhe( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
171 $ thresh, tsterr, nmax, a, afac, ainv,
b, x,
172 $ xact, work, rwork, iwork, nout )
181 INTEGER nmax, nn, nnb, nns, nout
182 DOUBLE PRECISION thresh
186 INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
187 DOUBLE PRECISION rwork( * )
188 COMPLEX*16 a( * ), afac( * ), ainv( * ),
b( * ),
189 $ work( * ), x( * ), xact( * )
195 DOUBLE PRECISION zero
196 parameter( zero = 0.0d+0 )
198 parameter( czero = ( 0.0d+0, 0.0d+0 ) )
200 parameter( ntypes = 10 )
202 parameter( ntests = 9 )
205 LOGICAL trfcon, zerot
206 CHARACTER dist, type, uplo, xtype
208 INTEGER i, i1, i2, imat, in, inb, info, ioff, irhs,
209 $ iuplo, izero,
j, k, kl, ku, lda, lwork, mode,
210 $ n, nb, nerrs, nfail, nimat, nrhs, nrun, nt
211 DOUBLE PRECISION anorm, cndnum, rcond, rcondc
215 INTEGER iseed( 4 ), iseedy( 4 )
216 DOUBLE PRECISION result( ntests )
237 COMMON / infoc / infot, nunit, ok, lerr
238 COMMON / srnamc / srnamt
241 DATA iseedy / 1988, 1989, 1990, 1991 /
242 DATA uplos /
'U',
'L' /
248 path( 1: 1 ) =
'Zomplex precision'
254 iseed( i ) = iseedy( i )
260 $ CALL
zerrhe( path, nout )
279 DO 170 imat = 1, nimat
283 IF( .NOT.dotype( imat ) )
288 zerot = imat.GE.3 .AND. imat.LE.6
289 IF( zerot .AND. n.LT.imat-2 )
295 uplo = uplos( iuplo )
300 CALL
zlatb4( path, imat, n, n, type, kl, ku, anorm, mode,
306 CALL
zlatms( n, n, dist, iseed, type, rwork, mode,
307 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
313 CALL
alaerh( path,
'ZLATMS', info, 0, uplo, n, n, -1,
314 $ -1, -1, imat, nfail, nerrs, nout )
327 ELSE IF( imat.EQ.4 )
THEN
337 IF( iuplo.EQ.1 )
THEN
338 ioff = ( izero-1 )*lda
339 DO 20 i = 1, izero - 1
349 DO 40 i = 1, izero - 1
359 IF( iuplo.EQ.1 )
THEN
394 CALL
zlaipd( n, a, lda+1, 0 )
410 CALL
zlacpy( uplo, n, n, a, lda, afac, lda )
417 lwork = max( 2, nb )*lda
419 CALL
zhetrf( uplo, n, afac, lda, iwork, ainv, lwork,
428 IF( iwork( k ).LT.0 )
THEN
429 IF( iwork( k ).NE.-k )
THEN
433 ELSE IF( iwork( k ).NE.k )
THEN
442 $ CALL
alaerh( path,
'ZHETRF', info, k, uplo, n, n,
443 $ -1, -1, nb, imat, nfail, nerrs, nout )
456 CALL
zhet01( uplo, n, a, lda, afac, lda, iwork, ainv,
457 $ lda, rwork, result( 1 ) )
463 IF( inb.EQ.1 .AND. .NOT.trfcon )
THEN
464 CALL
zlacpy( uplo, n, n, afac, lda, ainv, lda )
466 lwork = (n+nb+1)*(nb+3)
467 CALL
zhetri2( uplo, n, ainv, lda, iwork, work,
473 $ CALL
alaerh( path,
'ZHETRI', info, -1, uplo, n,
474 $ n, -1, -1, -1, imat, nfail, nerrs,
480 CALL
zpot03( uplo, n, a, lda, ainv, lda, work, lda,
481 $ rwork, rcondc, result( 2 ) )
489 IF( result( k ).GE.thresh )
THEN
490 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
491 $ CALL
alahd( nout, path )
492 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
524 CALL
zlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
525 $ nrhs, a, lda, xact, lda,
b, lda,
527 CALL
zlacpy(
'Full', n, nrhs,
b, lda, x, lda )
530 CALL
zhetrs( uplo, n, nrhs, afac, lda, iwork, x,
536 $ CALL
alaerh( path,
'ZHETRS', info, 0, uplo, n,
537 $ n, -1, -1, nrhs, imat, nfail,
540 CALL
zlacpy(
'Full', n, nrhs,
b, lda, work, lda )
544 CALL
zpot02( uplo, n, nrhs, a, lda, x, lda, work,
545 $ lda, rwork, result( 3 ) )
554 CALL
zlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
555 $ nrhs, a, lda, xact, lda,
b, lda,
557 CALL
zlacpy(
'Full', n, nrhs,
b, lda, x, lda )
560 CALL
zhetrs2( uplo, n, nrhs, afac, lda, iwork, x,
566 $ CALL
alaerh( path,
'ZHETRS2', info, 0, uplo, n,
567 $ n, -1, -1, nrhs, imat, nfail,
570 CALL
zlacpy(
'Full', n, nrhs,
b, lda, work, lda )
574 CALL
zpot02( uplo, n, nrhs, a, lda, x, lda, work,
575 $ lda, rwork, result( 4 ) )
580 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
587 CALL
zherfs( uplo, n, nrhs, a, lda, afac, lda,
588 $ iwork,
b, lda, x, lda, rwork,
589 $ rwork( nrhs+1 ), work,
590 $ rwork( 2*nrhs+1 ), info )
595 $ CALL
alaerh( path,
'ZHERFS', info, 0, uplo, n,
596 $ n, -1, -1, nrhs, imat, nfail,
599 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
601 CALL
zpot05( uplo, n, nrhs, a, lda,
b, lda, x, lda,
602 $ xact, lda, rwork, rwork( nrhs+1 ),
609 IF( result( k ).GE.thresh )
THEN
610 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
611 $ CALL
alahd( nout, path )
612 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
613 $ imat, k, result( k )
627 anorm =
zlanhe(
'1', uplo, n, a, lda, rwork )
629 CALL
zhecon( uplo, n, afac, lda, iwork, anorm, rcond,
635 $ CALL
alaerh( path,
'ZHECON', info, 0, uplo, n, n,
636 $ -1, -1, -1, imat, nfail, nerrs, nout )
638 result( 9 ) =
dget06( rcond, rcondc )
643 IF( result( 9 ).GE.thresh )
THEN
644 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
645 $ CALL
alahd( nout, path )
646 WRITE( nout, fmt = 9997 )uplo, n, imat, 9,
658 CALL
alasum( path, nout, nfail, nrun, nerrs )
660 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
661 $ i2,
', test ', i2,
', ratio =', g12.5 )
662 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
663 $ i2,
', test(', i2,
') =', g12.5 )
664 9997
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
665 $
', test(', i2,
') =', g12.5 )