167 SUBROUTINE zchkpb( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
168 $ thresh, tsterr, nmax, a, afac, ainv, b, x,
169 $ xact, work, rwork, nout )
178 INTEGER NMAX, NN, NNB, NNS, NOUT
179 DOUBLE PRECISION THRESH
183 INTEGER NBVAL( * ), NSVAL( * ), NVAL( * )
184 DOUBLE PRECISION RWORK( * )
185 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
186 $ work( * ), x( * ), xact( * )
192 DOUBLE PRECISION ONE, ZERO
193 parameter( one = 1.0d+0, zero = 0.0d+0 )
194 INTEGER NTYPES, NTESTS
195 parameter( ntypes = 8, ntests = 7 )
201 CHARACTER DIST, PACKIT,
TYPE, UPLO, XTYPE
203 INTEGER I, I1, I2, IKD, IMAT, IN, INB, INFO, IOFF,
204 $ irhs, iuplo, iw, izero, k, kd, kl, koff, ku,
205 $ lda, ldab, mode, n, nb, nerrs, nfail, nimat,
207 DOUBLE PRECISION AINVNM, ANORM, CNDNUM, RCOND, RCONDC
210 INTEGER ISEED( 4 ), ISEEDY( 4 ), KDVAL( nbw )
211 DOUBLE PRECISION RESULT( ntests )
214 DOUBLE PRECISION DGET06, ZLANGE, ZLANHB
215 EXTERNAL dget06, zlange, zlanhb
224 INTRINSIC dcmplx, max, min
232 COMMON / infoc / infot, nunit, ok, lerr
233 COMMON / srnamc / srnamt
236 DATA iseedy / 1988, 1989, 1990, 1991 /
242 path( 1: 1 ) =
'Zomplex precision'
248 iseed( i ) = iseedy( i )
254 $ CALL
zerrpo( path, nout )
267 nkd = max( 1, min( n, 4 ) )
272 kdval( 2 ) = n + ( n+1 ) / 4
273 kdval( 3 ) = ( 3*n-1 ) / 4
274 kdval( 4 ) = ( n+1 ) / 4
289 IF( iuplo.EQ.1 )
THEN
291 koff = max( 1, kd+2-n )
298 DO 60 imat = 1, nimat
302 IF( .NOT.dotype( imat ) )
307 zerot = imat.GE.2 .AND. imat.LE.4
308 IF( zerot .AND. n.LT.imat-1 )
311 IF( .NOT.zerot .OR. .NOT.dotype( 1 ) )
THEN
316 CALL
zlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM,
317 $ mode, cndnum, dist )
320 CALL
zlatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
321 $ cndnum, anorm, kd, kd, packit,
322 $ a( koff ), ldab, work, info )
327 CALL
alaerh( path,
'ZLATMS', info, 0, uplo, n,
328 $ n, kd, kd, -1, imat, nfail, nerrs,
332 ELSE IF( izero.GT.0 )
THEN
338 IF( iuplo.EQ.1 )
THEN
339 ioff = ( izero-1 )*ldab + kd + 1
340 CALL
zcopy( izero-i1, work( iw ), 1,
341 $ a( ioff-izero+i1 ), 1 )
343 CALL
zcopy( i2-izero+1, work( iw ), 1,
344 $ a( ioff ), max( ldab-1, 1 ) )
346 ioff = ( i1-1 )*ldab + 1
347 CALL
zcopy( izero-i1, work( iw ), 1,
348 $ a( ioff+izero-i1 ),
350 ioff = ( izero-1 )*ldab + 1
352 CALL
zcopy( i2-izero+1, work( iw ), 1,
364 ELSE IF( imat.EQ.3 )
THEN
373 DO 20 i = 1, min( 2*kd+1, n )
377 i1 = max( izero-kd, 1 )
378 i2 = min( izero+kd, n )
380 IF( iuplo.EQ.1 )
THEN
381 ioff = ( izero-1 )*ldab + kd + 1
382 CALL zswap( izero-i1, a( ioff-izero+i1 ), 1,
385 CALL zswap( i2-izero+1, a( ioff ),
386 $ max( ldab-1, 1 ), work( iw ), 1 )
388 ioff = ( i1-1 )*ldab + 1
389 CALL zswap( izero-i1, a( ioff+izero-i1 ),
390 $ max( ldab-1, 1 ), work( iw ), 1 )
391 ioff = ( izero-1 )*ldab + 1
393 CALL zswap( i2-izero+1, a( ioff ), 1,
400 IF( iuplo.EQ.1 )
THEN
401 CALL
zlaipd( n, a( kd+1 ), ldab, 0 )
403 CALL
zlaipd( n, a( 1 ), ldab, 0 )
415 CALL
zlacpy(
'Full', kd+1, n, a, ldab, afac, ldab )
417 CALL
zpbtrf( uplo, n, kd, afac, ldab, info )
421 IF( info.NE.izero )
THEN
422 CALL
alaerh( path,
'ZPBTRF', info, izero, uplo,
423 $ n, n, kd, kd, nb, imat, nfail,
437 CALL
zlacpy(
'Full', kd+1, n, afac, ldab, ainv,
439 CALL
zpbt01( uplo, n, kd, a, ldab, ainv, ldab,
440 $ rwork, result( 1 ) )
444 IF( result( 1 ).GE.thresh )
THEN
445 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
446 $ CALL
alahd( nout, path )
447 WRITE( nout, fmt = 9999 )uplo, n, kd, nb, imat,
461 CALL
zlaset(
'Full', n, n, dcmplx( zero ),
462 $ dcmplx( one ), ainv, lda )
464 CALL
zpbtrs( uplo, n, kd, n, afac, ldab, ainv, lda,
469 anorm = zlanhb(
'1', uplo, n, kd, a, ldab, rwork )
470 ainvnm = zlange(
'1', n, n, ainv, lda, rwork )
471 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
474 rcondc = ( one / anorm ) / ainvnm
484 CALL
zlarhs( path, xtype, uplo,
' ', n, n, kd,
485 $ kd, nrhs, a, ldab, xact, lda, b,
487 CALL
zlacpy(
'Full', n, nrhs, b, lda, x, lda )
490 CALL
zpbtrs( uplo, n, kd, nrhs, afac, ldab, x,
496 $ CALL
alaerh( path,
'ZPBTRS', info, 0, uplo,
497 $ n, n, kd, kd, nrhs, imat, nfail,
500 CALL
zlacpy(
'Full', n, nrhs, b, lda, work,
502 CALL
zpbt02( uplo, n, kd, nrhs, a, ldab, x, lda,
503 $ work, lda, rwork, result( 2 ) )
508 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
515 CALL
zpbrfs( uplo, n, kd, nrhs, a, ldab, afac,
516 $ ldab, b, lda, x, lda, rwork,
517 $ rwork( nrhs+1 ), work,
518 $ rwork( 2*nrhs+1 ), info )
523 $ CALL
alaerh( path,
'ZPBRFS', info, 0, uplo,
524 $ n, n, kd, kd, nrhs, imat, nfail,
527 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
529 CALL
zpbt05( uplo, n, kd, nrhs, a, ldab, b, lda,
530 $ x, lda, xact, lda, rwork,
531 $ rwork( nrhs+1 ), result( 5 ) )
537 IF( result( k ).GE.thresh )
THEN
538 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
539 $ CALL
alahd( nout, path )
540 WRITE( nout, fmt = 9998 )uplo, n, kd,
541 $ nrhs, imat, k, result( k )
552 CALL
zpbcon( uplo, n, kd, afac, ldab, anorm, rcond,
553 $ work, rwork, info )
558 $ CALL
alaerh( path,
'ZPBCON', info, 0, uplo, n,
559 $ n, kd, kd, -1, imat, nfail, nerrs,
562 result( 7 ) = dget06( rcond, rcondc )
566 IF( result( 7 ).GE.thresh )
THEN
567 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
568 $ CALL
alahd( nout, path )
569 WRITE( nout, fmt = 9997 )uplo, n, kd, imat, 7,
582 CALL
alasum( path, nout, nfail, nrun, nerrs )
584 9999
FORMAT(
' UPLO=''', a1,
''', N=', i5,
', KD=', i5,
', NB=', i4,
585 $
', type ', i2,
', test ', i2,
', ratio= ', g12.5 )
586 9998
FORMAT(
' UPLO=''', a1,
''', N=', i5,
', KD=', i5,
', NRHS=', i3,
587 $
', type ', i2,
', test(', i2,
') = ', g12.5 )
588 9997
FORMAT(
' UPLO=''', a1,
''', N=', i5,
', KD=', i5,
',', 10x,
589 $
' type ', i2,
', test(', i2,
') = ', g12.5 )
subroutine zpbt05(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPBT05
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zpbt01(UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK, RESID)
ZPBT01
subroutine zpbrfs(UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZPBRFS
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zpbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, RWORK, INFO)
ZPBCON
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zpbtrf(UPLO, N, KD, AB, LDAB, INFO)
ZPBTRF
subroutine zchkpb(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, NOUT)
ZCHKPB
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine zerrpo(PATH, NUNIT)
ZERRPO
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine zpbtrs(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
ZPBTRS
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
subroutine zpbt02(UPLO, N, KD, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZPBT02
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4