190 SUBROUTINE zchkgb( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS,
191 $ nsval, thresh, tsterr, a, la, afac, lafac,
b,
192 $
x, xact, work, rwork, iwork, nout )
201 INTEGER la, lafac, nm, nn, nnb, nns, nout
202 DOUBLE PRECISION thresh
206 INTEGER iwork( * ), mval( * ), nbval( * ), nsval( * ),
208 DOUBLE PRECISION rwork( * )
209 COMPLEX*16 a( * ), afac( * ),
b( * ), work( * ),
x( * ),
216 DOUBLE PRECISION one, zero
217 parameter( one = 1.0d+0, zero = 0.0d+0 )
218 INTEGER ntypes, ntests
219 parameter( ntypes = 8, ntests = 7 )
221 parameter( nbw = 4, ntran = 3 )
224 LOGICAL trfcon, zerot
225 CHARACTER dist, norm, trans, type, xtype
227 INTEGER i, i1, i2, ikl, iku, im, imat, in, inb, info,
228 $ ioff, irhs, itran, izero,
j, k, kl, koff, ku,
229 $ lda, ldafac, ldb, m, mode, n, nb, nerrs, nfail,
230 $ nimat, nkl, nku, nrhs, nrun
231 DOUBLE PRECISION ainvnm, anorm, anormi, anormo, cndnum, rcond,
232 $ rcondc, rcondi, rcondo
235 CHARACTER transs( ntran )
236 INTEGER iseed( 4 ), iseedy( 4 ), klval( nbw ),
238 DOUBLE PRECISION result( ntests )
251 INTRINSIC dcmplx, max, min
259 COMMON / infoc / infot, nunit, ok, lerr
260 COMMON / srnamc / srnamt
263 DATA iseedy / 1988, 1989, 1990, 1991 / ,
264 $ transs /
'N',
'T',
'C' /
270 path( 1: 1 ) =
'Zomplex precision'
276 iseed( i ) = iseedy( i )
282 $ CALL
zerrge( path, nout )
297 klval( 2 ) = m + ( m+1 ) / 4
301 klval( 3 ) = ( 3*m-1 ) / 4
302 klval( 4 ) = ( m+1 ) / 4
312 kuval( 2 ) = n + ( n+1 ) / 4
316 kuval( 3 ) = ( 3*n-1 ) / 4
317 kuval( 4 ) = ( n+1 ) / 4
328 IF( m.LE.0 .OR. n.LE.0 )
350 ldafac = 2*kl + ku + 1
351 IF( ( lda*n ).GT.la .OR. ( ldafac*n ).GT.lafac )
THEN
352 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
353 $ CALL
alahd( nout, path )
354 IF( n*( kl+ku+1 ).GT.la )
THEN
355 WRITE( nout, fmt = 9999 )la, m, n, kl, ku,
359 IF( n*( 2*kl+ku+1 ).GT.lafac )
THEN
360 WRITE( nout, fmt = 9998 )lafac, m, n, kl, ku,
367 DO 120 imat = 1, nimat
371 IF( .NOT.dotype( imat ) )
377 zerot = imat.GE.2 .AND. imat.LE.4
378 IF( zerot .AND. n.LT.imat-1 )
381 IF( .NOT.zerot .OR. .NOT.dotype( 1 ) )
THEN
386 CALL
zlatb4( path, imat, m, n, type, kl, ku,
387 $ anorm, mode, cndnum, dist )
389 koff = max( 1, ku+2-n )
390 DO 20 i = 1, koff - 1
394 CALL
zlatms( m, n, dist, iseed, type, rwork,
395 $ mode, cndnum, anorm, kl, ku,
'Z',
396 $ a( koff ), lda, work, info )
401 CALL
alaerh( path,
'ZLATMS', info, 0,
' ', m,
402 $ n, kl, ku, -1, imat, nfail,
406 ELSE IF( izero.GT.0 )
THEN
411 CALL
zcopy( i2-i1+1,
b, 1, a( ioff+i1 ), 1 )
421 ELSE IF( imat.EQ.3 )
THEN
424 izero = min( m, n ) / 2 + 1
426 ioff = ( izero-1 )*lda
431 i1 = max( 1, ku+2-izero )
432 i2 = min( kl+ku+1, ku+1+( m-izero ) )
433 CALL
zcopy( i2-i1+1, a( ioff+i1 ), 1,
b, 1 )
440 DO 40 i = max( 1, ku+2-
j ),
441 $ min( kl+ku+1, ku+1+( m-
j ) )
464 IF( m.GT.0 .AND. n.GT.0 )
465 $ CALL
zlacpy(
'Full', kl+ku+1, n, a, lda,
466 $ afac( kl+1 ), ldafac )
468 CALL
zgbtrf( m, n, kl, ku, afac, ldafac, iwork,
474 $ CALL
alaerh( path,
'ZGBTRF', info, izero,
475 $
' ', m, n, kl, ku, nb, imat,
476 $ nfail, nerrs, nout )
483 CALL
zgbt01( m, n, kl, ku, a, lda, afac, ldafac,
484 $ iwork, work, result( 1 ) )
489 IF( result( 1 ).GE.thresh )
THEN
490 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
491 $ CALL
alahd( nout, path )
492 WRITE( nout, fmt = 9997 )m, n, kl, ku, nb,
493 $ imat, 1, result( 1 )
501 IF( inb.GT.1 .OR. m.NE.n )
504 anormo =
zlangb(
'O', n, kl, ku, a, lda, rwork )
505 anormi =
zlangb(
'I', n, kl, ku, a, lda, rwork )
513 CALL
zlaset(
'Full', n, n, dcmplx( zero ),
514 $ dcmplx( one ), work, ldb )
516 CALL
zgbtrs(
'No transpose', n, kl, ku, n,
517 $ afac, ldafac, iwork, work, ldb,
522 ainvnm =
zlange(
'O', n, n, work, ldb,
524 IF( anormo.LE.zero .OR. ainvnm.LE.zero )
THEN
527 rcondo = ( one / anormo ) / ainvnm
533 ainvnm =
zlange(
'I', n, n, work, ldb,
535 IF( anormi.LE.zero .OR. ainvnm.LE.zero )
THEN
538 rcondi = ( one / anormi ) / ainvnm
558 DO 70 itran = 1, ntran
559 trans = transs( itran )
560 IF( itran.EQ.1 )
THEN
572 CALL
zlarhs( path, xtype,
' ', trans, n,
573 $ n, kl, ku, nrhs, a, lda,
574 $ xact, ldb,
b, ldb, iseed,
577 CALL
zlacpy(
'Full', n, nrhs,
b, ldb,
x,
581 CALL
zgbtrs( trans, n, kl, ku, nrhs, afac,
582 $ ldafac, iwork,
x, ldb, info )
587 $ CALL
alaerh( path,
'ZGBTRS', info, 0,
588 $ trans, n, n, kl, ku, -1,
589 $ imat, nfail, nerrs, nout )
591 CALL
zlacpy(
'Full', n, nrhs,
b, ldb,
593 CALL
zgbt02( trans, m, n, kl, ku, nrhs, a,
594 $ lda,
x, ldb, work, ldb,
601 CALL
zget04( n, nrhs,
x, ldb, xact, ldb,
602 $ rcondc, result( 3 ) )
609 CALL
zgbrfs( trans, n, kl, ku, nrhs, a,
610 $ lda, afac, ldafac, iwork,
b,
611 $ ldb,
x, ldb, rwork,
612 $ rwork( nrhs+1 ), work,
613 $ rwork( 2*nrhs+1 ), info )
618 $ CALL
alaerh( path,
'ZGBRFS', info, 0,
619 $ trans, n, n, kl, ku, nrhs,
620 $ imat, nfail, nerrs, nout )
622 CALL
zget04( n, nrhs,
x, ldb, xact, ldb,
623 $ rcondc, result( 4 ) )
624 CALL
zgbt05( trans, n, kl, ku, nrhs, a,
625 $ lda,
b, ldb,
x, ldb, xact,
626 $ ldb, rwork, rwork( nrhs+1 ),
633 IF( result( k ).GE.thresh )
THEN
634 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
635 $ CALL
alahd( nout, path )
636 WRITE( nout, fmt = 9996 )trans, n,
637 $ kl, ku, nrhs, imat, k,
651 IF( itran.EQ.1 )
THEN
661 CALL
zgbcon( norm, n, kl, ku, afac, ldafac,
662 $ iwork, anorm, rcond, work,
668 $ CALL
alaerh( path,
'ZGBCON', info, 0,
669 $ norm, n, n, kl, ku, -1, imat,
670 $ nfail, nerrs, nout )
672 result( 7 ) =
dget06( rcond, rcondc )
677 IF( result( 7 ).GE.thresh )
THEN
678 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
679 $ CALL
alahd( nout, path )
680 WRITE( nout, fmt = 9995 )norm, n, kl, ku,
681 $ imat, 7, result( 7 )
695 CALL
alasum( path, nout, nfail, nrun, nerrs )
697 9999
FORMAT(
' *** In ZCHKGB, LA=', i5,
' is too small for M=', i5,
698 $
', N=', i5,
', KL=', i4,
', KU=', i4,
699 $ /
' ==> Increase LA to at least ', i5 )
700 9998
FORMAT(
' *** In ZCHKGB, LAFAC=', i5,
' is too small for M=', i5,
701 $
', N=', i5,
', KL=', i4,
', KU=', i4,
702 $ /
' ==> Increase LAFAC to at least ', i5 )
703 9997
FORMAT(
' M =', i5,
', N =', i5,
', KL=', i5,
', KU=', i5,
704 $
', NB =', i4,
', type ', i1,
', test(', i1,
')=', g12.5 )
705 9996
FORMAT(
' TRANS=''', a1,
''', N=', i5,
', KL=', i5,
', KU=', i5,
706 $
', NRHS=', i3,
', type ', i1,
', test(', i1,
')=', g12.5 )
707 9995
FORMAT(
' NORM =''', a1,
''', N=', i5,
', KL=', i5,
', KU=', i5,
708 $
',', 10
x,
' type ', i1,
', test(', i1,
')=', g12.5 )
subroutine zgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGBRFS
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
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 alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
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 zgbt01(M, N, KL, KU, A, LDA, AFAC, LDAFAC, IPIV, WORK, RESID)
ZGBT01
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 zgbt02(TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, RESID)
ZGBT02
DOUBLE PRECISION function dget06(RCOND, RCONDC)
DGET06
subroutine zgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, RWORK, INFO)
ZGBCON
subroutine zgbt05(TRANS, N, KL, KU, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZGBT05
subroutine zgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
ZGBTRS
subroutine zerrge(PATH, NUNIT)
ZERRGE
DOUBLE PRECISION function zlangb(NORM, N, KL, KU, AB, LDAB, WORK)
ZLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
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 zgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
ZGBTRF
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4