158 SUBROUTINE zdrvpb( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
159 $ a, afac, asav, b, bsav, x, xact, s, work,
169 INTEGER NMAX, NN, NOUT, NRHS
170 DOUBLE PRECISION THRESH
175 DOUBLE PRECISION RWORK( * ), S( * )
176 COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ),
177 $ bsav( * ), work( * ), x( * ), xact( * )
183 DOUBLE PRECISION ONE, ZERO
184 parameter( one = 1.0d+0, zero = 0.0d+0 )
185 INTEGER NTYPES, NTESTS
186 parameter( ntypes = 8, ntests = 6 )
191 LOGICAL EQUIL, NOFACT, PREFAC, ZEROT
192 CHARACTER DIST, EQUED, FACT, PACKIT,
TYPE, UPLO, XTYPE
194 INTEGER I, I1, I2, IEQUED, IFACT, IKD, IMAT, IN, INFO,
195 $ ioff, iuplo, iw, izero, k, k1, kd, kl, koff,
196 $ ku, lda, ldab, mode, n, nb, nbmin, nerrs,
197 $ nfact, nfail, nimat, nkd, nrun, nt
198 DOUBLE PRECISION AINVNM, AMAX, ANORM, CNDNUM, RCOND, RCONDC,
202 CHARACTER EQUEDS( 2 ), FACTS( 3 )
203 INTEGER ISEED( 4 ), ISEEDY( 4 ), KDVAL( nbw )
204 DOUBLE PRECISION RESULT( ntests )
208 DOUBLE PRECISION DGET06, ZLANGE, ZLANHB
209 EXTERNAL lsame, dget06, zlange, zlanhb
218 INTRINSIC dcmplx, max, min
226 COMMON / infoc / infot, nunit, ok, lerr
227 COMMON / srnamc / srnamt
230 DATA iseedy / 1988, 1989, 1990, 1991 /
231 DATA facts /
'F',
'N',
'E' / , equeds /
'N',
'Y' /
237 path( 1: 1 ) =
'Zomplex precision'
243 iseed( i ) = iseedy( i )
249 $ CALL
zerrvx( path, nout )
269 nkd = max( 1, min( n, 4 ) )
274 kdval( 2 ) = n + ( n+1 ) / 4
275 kdval( 3 ) = ( 3*n-1 ) / 4
276 kdval( 4 ) = ( n+1 ) / 4
291 IF( iuplo.EQ.1 )
THEN
294 koff = max( 1, kd+2-n )
300 DO 80 imat = 1, nimat
304 IF( .NOT.dotype( imat ) )
309 zerot = imat.GE.2 .AND. imat.LE.4
310 IF( zerot .AND. n.LT.imat-1 )
313 IF( .NOT.zerot .OR. .NOT.dotype( 1 ) )
THEN
318 CALL
zlatb4( path, imat, n, n,
TYPE, KL, KU, ANORM,
319 $ mode, cndnum, dist )
322 CALL
zlatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
323 $ cndnum, anorm, kd, kd, packit,
324 $ a( koff ), ldab, work, info )
329 CALL
alaerh( path,
'ZLATMS', info, 0, uplo, n,
330 $ n, -1, -1, -1, imat, nfail, nerrs,
334 ELSE IF( izero.GT.0 )
THEN
340 IF( iuplo.EQ.1 )
THEN
341 ioff = ( izero-1 )*ldab + kd + 1
342 CALL
zcopy( izero-i1, work( iw ), 1,
343 $ a( ioff-izero+i1 ), 1 )
345 CALL
zcopy( i2-izero+1, work( iw ), 1,
346 $ a( ioff ), max( ldab-1, 1 ) )
348 ioff = ( i1-1 )*ldab + 1
349 CALL
zcopy( izero-i1, work( iw ), 1,
350 $ a( ioff+izero-i1 ),
352 ioff = ( izero-1 )*ldab + 1
354 CALL
zcopy( i2-izero+1, work( iw ), 1,
366 ELSE IF( imat.EQ.3 )
THEN
375 DO 20 i = 1, min( 2*kd+1, n )
379 i1 = max( izero-kd, 1 )
380 i2 = min( izero+kd, n )
382 IF( iuplo.EQ.1 )
THEN
383 ioff = ( izero-1 )*ldab + kd + 1
384 CALL zswap( izero-i1, a( ioff-izero+i1 ), 1,
387 CALL zswap( i2-izero+1, a( ioff ),
388 $ max( ldab-1, 1 ), work( iw ), 1 )
390 ioff = ( i1-1 )*ldab + 1
391 CALL zswap( izero-i1, a( ioff+izero-i1 ),
392 $ max( ldab-1, 1 ), work( iw ), 1 )
393 ioff = ( izero-1 )*ldab + 1
395 CALL zswap( i2-izero+1, a( ioff ), 1,
402 IF( iuplo.EQ.1 )
THEN
403 CALL
zlaipd( n, a( kd+1 ), ldab, 0 )
405 CALL
zlaipd( n, a( 1 ), ldab, 0 )
410 CALL
zlacpy(
'Full', kd+1, n, a, ldab, asav, ldab )
413 equed = equeds( iequed )
414 IF( iequed.EQ.1 )
THEN
420 DO 60 ifact = 1, nfact
421 fact = facts( ifact )
422 prefac = lsame( fact,
'F' )
423 nofact = lsame( fact,
'N' )
424 equil = lsame( fact,
'E' )
431 ELSE IF( .NOT.lsame( fact,
'N' ) )
THEN
438 CALL
zlacpy(
'Full', kd+1, n, asav, ldab,
440 IF( equil .OR. iequed.GT.1 )
THEN
445 CALL
zpbequ( uplo, n, kd, afac, ldab, s,
446 $ scond, amax, info )
447 IF( info.EQ.0 .AND. n.GT.0 )
THEN
453 CALL
zlaqhb( uplo, n, kd, afac, ldab,
454 $ s, scond, amax, equed )
466 anorm = zlanhb(
'1', uplo, n, kd, afac, ldab,
471 CALL
zpbtrf( uplo, n, kd, afac, ldab, info )
475 CALL
zlaset(
'Full', n, n, dcmplx( zero ),
476 $ dcmplx( one ), a, lda )
478 CALL
zpbtrs( uplo, n, kd, n, afac, ldab, a,
483 ainvnm = zlange(
'1', n, n, a, lda, rwork )
484 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
487 rcondc = ( one / anorm ) / ainvnm
493 CALL
zlacpy(
'Full', kd+1, n, asav, ldab, a,
500 CALL
zlarhs( path, xtype, uplo,
' ', n, n, kd,
501 $ kd, nrhs, a, ldab, xact, lda, b,
504 CALL
zlacpy(
'Full', n, nrhs, b, lda, bsav,
514 CALL
zlacpy(
'Full', kd+1, n, a, ldab, afac,
516 CALL
zlacpy(
'Full', n, nrhs, b, lda, x,
520 CALL
zpbsv( uplo, n, kd, nrhs, afac, ldab, x,
525 IF( info.NE.izero )
THEN
526 CALL
alaerh( path,
'ZPBSV ', info, izero,
527 $ uplo, n, n, kd, kd, nrhs,
528 $ imat, nfail, nerrs, nout )
530 ELSE IF( info.NE.0 )
THEN
537 CALL
zpbt01( uplo, n, kd, a, ldab, afac,
538 $ ldab, rwork, result( 1 ) )
542 CALL
zlacpy(
'Full', n, nrhs, b, lda, work,
544 CALL
zpbt02( uplo, n, kd, nrhs, a, ldab, x,
545 $ lda, work, lda, rwork,
550 CALL
zget04( n, nrhs, x, lda, xact, lda,
551 $ rcondc, result( 3 ) )
558 IF( result( k ).GE.thresh )
THEN
559 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
560 $ CALL
aladhd( nout, path )
561 WRITE( nout, fmt = 9999 )
'ZPBSV ',
562 $ uplo, n, kd, imat, k, result( k )
573 $ CALL
zlaset(
'Full', kd+1, n, dcmplx( zero ),
574 $ dcmplx( zero ), afac, ldab )
575 CALL
zlaset(
'Full', n, nrhs, dcmplx( zero ),
576 $ dcmplx( zero ), x, lda )
577 IF( iequed.GT.1 .AND. n.GT.0 )
THEN
582 CALL
zlaqhb( uplo, n, kd, a, ldab, s, scond,
590 CALL
zpbsvx( fact, uplo, n, kd, nrhs, a, ldab,
591 $ afac, ldab, equed, s, b, lda, x,
592 $ lda, rcond, rwork, rwork( nrhs+1 ),
593 $ work, rwork( 2*nrhs+1 ), info )
597 IF( info.NE.izero )
THEN
598 CALL
alaerh( path,
'ZPBSVX', info, izero,
599 $ fact // uplo, n, n, kd, kd,
600 $ nrhs, imat, nfail, nerrs, nout )
605 IF( .NOT.prefac )
THEN
610 CALL
zpbt01( uplo, n, kd, a, ldab, afac,
611 $ ldab, rwork( 2*nrhs+1 ),
620 CALL
zlacpy(
'Full', n, nrhs, bsav, lda,
622 CALL
zpbt02( uplo, n, kd, nrhs, asav, ldab,
624 $ rwork( 2*nrhs+1 ), result( 2 ) )
628 IF( nofact .OR. ( prefac .AND. lsame( equed,
630 CALL
zget04( n, nrhs, x, lda, xact, lda,
631 $ rcondc, result( 3 ) )
633 CALL
zget04( n, nrhs, x, lda, xact, lda,
634 $ roldc, result( 3 ) )
640 CALL
zpbt05( uplo, n, kd, nrhs, asav, ldab,
641 $ b, lda, x, lda, xact, lda,
642 $ rwork, rwork( nrhs+1 ),
651 result( 6 ) = dget06( rcond, rcondc )
657 IF( result( k ).GE.thresh )
THEN
658 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
659 $ CALL
aladhd( nout, path )
661 WRITE( nout, fmt = 9997 )
'ZPBSVX',
662 $ fact, uplo, n, kd, equed, imat, k,
665 WRITE( nout, fmt = 9998 )
'ZPBSVX',
666 $ fact, uplo, n, kd, imat, k,
682 CALL
alasvm( path, nout, nfail, nrun, nerrs )
684 9999
FORMAT( 1x, a,
', UPLO=''', a1,
''', N =', i5,
', KD =', i5,
685 $
', type ', i1,
', test(', i1,
')=', g12.5 )
686 9998
FORMAT( 1x, a,
'( ''', a1,
''', ''', a1,
''', ', i5,
', ', i5,
687 $
', ... ), type ', i1,
', test(', i1,
')=', g12.5 )
688 9997
FORMAT( 1x, a,
'( ''', a1,
''', ''', a1,
''', ', i5,
', ', i5,
689 $
', ... ), EQUED=''', a1,
''', type ', i1,
', test(', i1,
subroutine zpbt05(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPBT05
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zpbt01(UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK, RESID)
ZPBT01
subroutine zpbsv(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
ZPBSV computes the solution to system of linear equations A * X = B for OTHER matrices ...
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
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 zpbtrf(UPLO, N, KD, AB, LDAB, INFO)
ZPBTRF
subroutine zdrvpb(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, NOUT)
ZDRVPB
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 zpbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
ZPBEQU
subroutine zpbsvx(FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine aladhd(IOUNIT, PATH)
ALADHD
subroutine zerrvx(PATH, NUNIT)
ZERRVX
subroutine zpbtrs(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
ZPBTRS
subroutine zlaqhb(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED)
ZLAQHB scales a Hermitian band matrix, using scaling factors computed by cpbequ.
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