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 )
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 zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
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
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
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
double precision function zlanhb(NORM, UPLO, N, K, AB, LDAB, WORK)
ZLANHB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a Hermitian band matrix.
double precision function dget06(RCOND, RCONDC)
DGET06
subroutine zerrpo(PATH, NUNIT)
ZERRPO
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
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