188 SUBROUTINE zchkgb( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS,
189 $ NSVAL, THRESH, TSTERR, A, LA, AFAC, LAFAC, B,
190 $ X, XACT, WORK, RWORK, IWORK, NOUT )
198 INTEGER LA, LAFAC, NM, NN, NNB, NNS, NOUT
199 DOUBLE PRECISION THRESH
203 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
205 DOUBLE PRECISION RWORK( * )
206 COMPLEX*16 A( * ), AFAC( * ), B( * ), WORK( * ), X( * ),
213 DOUBLE PRECISION ONE, ZERO
214 PARAMETER ( ONE = 1.0d+0, zero = 0.0d+0 )
215 INTEGER NTYPES, NTESTS
216 parameter( ntypes = 8, ntests = 7 )
218 parameter( nbw = 4, ntran = 3 )
221 LOGICAL TRFCON, ZEROT
222 CHARACTER DIST, NORM, TRANS,
TYPE, XTYPE
224 INTEGER I, I1, I2, IKL, IKU, IM, IMAT, IN, INB, INFO,
225 $ ioff, irhs, itran, izero, j, k, kl, koff, ku,
226 $ lda, ldafac, ldb, m, mode, n, nb, nerrs, nfail,
227 $ nimat, nkl, nku, nrhs, nrun
228 DOUBLE PRECISION AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, RCOND,
229 $ RCONDC, RCONDI, RCONDO
232 CHARACTER TRANSS( NTRAN )
233 INTEGER ISEED( 4 ), ISEEDY( 4 ), KLVAL( NBW ),
235 DOUBLE PRECISION RESULT( NTESTS )
238 DOUBLE PRECISION DGET06, ZLANGB, ZLANGE
239 EXTERNAL DGET06, ZLANGB, ZLANGE
248 INTRINSIC dcmplx, max, min
256 COMMON / infoc / infot, nunit, ok, lerr
257 COMMON / srnamc / srnamt
260 DATA iseedy / 1988, 1989, 1990, 1991 / ,
261 $ transs /
'N',
'T',
'C' /
267 path( 1: 1 ) =
'Zomplex precision'
273 iseed( i ) = iseedy( i )
279 $
CALL zerrge( path, nout )
294 klval( 2 ) = m + ( m+1 ) / 4
298 klval( 3 ) = ( 3*m-1 ) / 4
299 klval( 4 ) = ( m+1 ) / 4
309 kuval( 2 ) = n + ( n+1 ) / 4
313 kuval( 3 ) = ( 3*n-1 ) / 4
314 kuval( 4 ) = ( n+1 ) / 4
325 IF( m.LE.0 .OR. n.LE.0 )
347 ldafac = 2*kl + ku + 1
348 IF( ( lda*n ).GT.la .OR. ( ldafac*n ).GT.lafac )
THEN
349 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
350 $
CALL alahd( nout, path )
351 IF( n*( kl+ku+1 ).GT.la )
THEN
352 WRITE( nout, fmt = 9999 )la, m, n, kl, ku,
356 IF( n*( 2*kl+ku+1 ).GT.lafac )
THEN
357 WRITE( nout, fmt = 9998 )lafac, m, n, kl, ku,
364 DO 120 imat = 1, nimat
368 IF( .NOT.dotype( imat ) )
374 zerot = imat.GE.2 .AND. imat.LE.4
375 IF( zerot .AND. n.LT.imat-1 )
378 IF( .NOT.zerot .OR. .NOT.dotype( 1 ) )
THEN
383 CALL zlatb4( path, imat, m, n,
TYPE, kl, ku,
384 $ anorm, mode, cndnum, dist )
386 koff = max( 1, ku+2-n )
387 DO 20 i = 1, koff - 1
391 CALL zlatms( m, n, dist, iseed,
TYPE, rwork,
392 $ mode, cndnum, anorm, kl, ku,
'Z',
393 $ a( koff ), lda, work, info )
398 CALL alaerh( path,
'ZLATMS', info, 0,
' ', m,
399 $ n, kl, ku, -1, imat, nfail,
403 ELSE IF( izero.GT.0 )
THEN
408 CALL zcopy( i2-i1+1, b, 1, a( ioff+i1 ), 1 )
418 ELSE IF( imat.EQ.3 )
THEN
421 izero = min( m, n ) / 2 + 1
423 ioff = ( izero-1 )*lda
428 i1 = max( 1, ku+2-izero )
429 i2 = min( kl+ku+1, ku+1+( m-izero ) )
430 CALL zcopy( i2-i1+1, a( ioff+i1 ), 1, b, 1 )
437 DO 40 i = max( 1, ku+2-j ),
438 $ min( kl+ku+1, ku+1+( m-j ) )
461 IF( m.GT.0 .AND. n.GT.0 )
462 $
CALL zlacpy(
'Full', kl+ku+1, n, a, lda,
463 $ afac( kl+1 ), ldafac )
465 CALL zgbtrf( m, n, kl, ku, afac, ldafac, iwork,
471 $
CALL alaerh( path,
'ZGBTRF', info, izero,
472 $
' ', m, n, kl, ku, nb, imat,
473 $ nfail, nerrs, nout )
480 CALL zgbt01( m, n, kl, ku, a, lda, afac, ldafac,
481 $ iwork, work, result( 1 ) )
486 IF( result( 1 ).GE.thresh )
THEN
487 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
488 $
CALL alahd( nout, path )
489 WRITE( nout, fmt = 9997 )m, n, kl, ku, nb,
490 $ imat, 1, result( 1 )
498 IF( inb.GT.1 .OR. m.NE.n )
501 anormo = zlangb(
'O', n, kl, ku, a, lda, rwork )
502 anormi = zlangb(
'I', n, kl, ku, a, lda, rwork )
510 CALL zlaset(
'Full', n, n, dcmplx( zero ),
511 $ dcmplx( one ), work, ldb )
513 CALL zgbtrs(
'No transpose', n, kl, ku, n,
514 $ afac, ldafac, iwork, work, ldb,
519 ainvnm = zlange(
'O', n, n, work, ldb,
521 IF( anormo.LE.zero .OR. ainvnm.LE.zero )
THEN
524 rcondo = ( one / anormo ) / ainvnm
530 ainvnm = zlange(
'I', n, n, work, ldb,
532 IF( anormi.LE.zero .OR. ainvnm.LE.zero )
THEN
535 rcondi = ( one / anormi ) / ainvnm
555 DO 70 itran = 1, ntran
556 trans = transs( itran )
557 IF( itran.EQ.1 )
THEN
569 CALL zlarhs( path, xtype,
' ', trans, n,
570 $ n, kl, ku, nrhs, a, lda,
571 $ xact, ldb, b, ldb, iseed,
574 CALL zlacpy(
'Full', n, nrhs, b, ldb, x,
578 CALL zgbtrs( trans, n, kl, ku, nrhs, afac,
579 $ ldafac, iwork, x, ldb, info )
584 $
CALL alaerh( path,
'ZGBTRS', info, 0,
585 $ trans, n, n, kl, ku, -1,
586 $ imat, nfail, nerrs, nout )
588 CALL zlacpy(
'Full', n, nrhs, b, ldb,
590 CALL zgbt02( trans, m, n, kl, ku, nrhs, a,
591 $ lda, x, ldb, work, ldb,
592 $ rwork, result( 2 ) )
598 CALL zget04( n, nrhs, x, ldb, xact, ldb,
599 $ rcondc, result( 3 ) )
606 CALL zgbrfs( trans, n, kl, ku, nrhs, a,
607 $ lda, afac, ldafac, iwork, b,
608 $ ldb, x, ldb, rwork,
609 $ rwork( nrhs+1 ), work,
610 $ rwork( 2*nrhs+1 ), info )
615 $
CALL alaerh( path,
'ZGBRFS', info, 0,
616 $ trans, n, n, kl, ku, nrhs,
617 $ imat, nfail, nerrs, nout )
619 CALL zget04( n, nrhs, x, ldb, xact, ldb,
620 $ rcondc, result( 4 ) )
621 CALL zgbt05( trans, n, kl, ku, nrhs, a,
622 $ lda, b, ldb, x, ldb, xact,
623 $ ldb, rwork, rwork( nrhs+1 ),
630 IF( result( k ).GE.thresh )
THEN
631 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
632 $
CALL alahd( nout, path )
633 WRITE( nout, fmt = 9996 )trans, n,
634 $ kl, ku, nrhs, imat, k,
648 IF( itran.EQ.1 )
THEN
658 CALL zgbcon( norm, n, kl, ku, afac, ldafac,
659 $ iwork, anorm, rcond, work,
665 $
CALL alaerh( path,
'ZGBCON', info, 0,
666 $ norm, n, n, kl, ku, -1, imat,
667 $ nfail, nerrs, nout )
669 result( 7 ) = dget06( rcond, rcondc )
674 IF( result( 7 ).GE.thresh )
THEN
675 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
676 $
CALL alahd( nout, path )
677 WRITE( nout, fmt = 9995 )norm, n, kl, ku,
678 $ imat, 7, result( 7 )
692 CALL alasum( path, nout, nfail, nrun, nerrs )
694 9999
FORMAT(
' *** In ZCHKGB, LA=', i5,
' is too small for M=', i5,
695 $
', N=', i5,
', KL=', i4,
', KU=', i4,
696 $ /
' ==> Increase LA to at least ', i5 )
697 9998
FORMAT(
' *** In ZCHKGB, LAFAC=', i5,
' is too small for M=', i5,
698 $
', N=', i5,
', KL=', i4,
', KU=', i4,
699 $ /
' ==> Increase LAFAC to at least ', i5 )
700 9997
FORMAT(
' M =', i5,
', N =', i5,
', KL=', i5,
', KU=', i5,
701 $
', NB =', i4,
', type ', i1,
', test(', i1,
')=', g12.5 )
702 9996
FORMAT(
' TRANS=''', a1,
''', N=', i5,
', KL=', i5,
', KU=', i5,
703 $
', NRHS=', i3,
', type ', i1,
', test(', i1,
')=', g12.5 )
704 9995
FORMAT(
' NORM =''', a1,
''', N=', i5,
', KL=', i5,
', KU=', i5,
705 $
',', 10x,
' type ', i1,
', test(', i1,
')=', g12.5 )
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
subroutine xlaenv(ispec, nvalue)
XLAENV
subroutine zlarhs(path, xtype, uplo, trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, iseed, info)
ZLARHS
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
subroutine alahd(iounit, path)
ALAHD
subroutine zcopy(n, zx, incx, zy, incy)
ZCOPY
subroutine zgbcon(norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond, work, rwork, info)
ZGBCON
subroutine zgbrfs(trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
ZGBRFS
subroutine zgbtrf(m, n, kl, ku, ab, ldab, ipiv, info)
ZGBTRF
subroutine zgbtrs(trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
ZGBTRS
subroutine zlacpy(uplo, m, n, a, lda, b, ldb)
ZLACPY copies all or part of one two-dimensional array to another.
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 zchkgb(dotype, nm, mval, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, a, la, afac, lafac, b, x, xact, work, rwork, iwork, nout)
ZCHKGB
subroutine zerrge(path, nunit)
ZERRGE
subroutine zgbt01(m, n, kl, ku, a, lda, afac, ldafac, ipiv, work, resid)
ZGBT01
subroutine zgbt02(trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, rwork, resid)
ZGBT02
subroutine zgbt05(trans, n, kl, ku, nrhs, ab, ldab, b, ldb, x, ldx, xact, ldxact, ferr, berr, reslts)
ZGBT05
subroutine zget04(n, nrhs, x, ldx, xact, ldxact, rcond, resid)
ZGET04
subroutine zlatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
ZLATB4
subroutine zlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
ZLATMS