201 INTEGER la, lafac, nm, nn, nnb, nns, nout
206 INTEGER iwork( * ), mval( * ), nbval( * ), nsval( * ),
209 COMPLEX a( * ), afac( * ), b( * ), work( * ), x( * ),
217 parameter ( one = 1.0e+0, zero = 0.0e+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 REAL ainvnm, anorm, anormi, anormo, cndnum, rcond,
232 $ rcondc, rcondi, rcondo
235 CHARACTER transs( ntran )
236 INTEGER iseed( 4 ), iseedy( 4 ), klval( nbw ),
238 REAL result( ntests )
251 INTRINSIC cmplx, 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 ) =
'Complex precision'
276 iseed( i ) = iseedy( i )
282 $
CALL cerrge( 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 clatb4( 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 clatms( m, n, dist, iseed,
TYPE, rwork,
395 $ mode, cndnum, anorm, kl, ku,
'Z',
396 $ a( koff ), lda, work, info )
401 CALL alaerh( path,
'CLATMS', info, 0,
' ', m,
402 $ n, kl, ku, -1, imat, nfail,
406 ELSE IF( izero.GT.0 )
THEN
411 CALL ccopy( 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 ccopy( 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 clacpy(
'Full', kl+ku+1, n, a, lda,
466 $ afac( kl+1 ), ldafac )
468 CALL cgbtrf( m, n, kl, ku, afac, ldafac, iwork,
474 $
CALL alaerh( path,
'CGBTRF', info, izero,
475 $
' ', m, n, kl, ku, nb, imat,
476 $ nfail, nerrs, nout )
483 CALL cgbt01( 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 =
clangb(
'O', n, kl, ku, a, lda, rwork )
505 anormi =
clangb(
'I', n, kl, ku, a, lda, rwork )
513 CALL claset(
'Full', n, n, cmplx( zero ),
514 $ cmplx( one ), work, ldb )
516 CALL cgbtrs(
'No transpose', n, kl, ku, n,
517 $ afac, ldafac, iwork, work, ldb,
522 ainvnm =
clange(
'O', n, n, work, ldb,
524 IF( anormo.LE.zero .OR. ainvnm.LE.zero )
THEN
527 rcondo = ( one / anormo ) / ainvnm
533 ainvnm =
clange(
'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 clarhs( path, xtype,
' ', trans, n,
573 $ n, kl, ku, nrhs, a, lda,
574 $ xact, ldb, b, ldb, iseed,
577 CALL clacpy(
'Full', n, nrhs, b, ldb, x,
581 CALL cgbtrs( trans, n, kl, ku, nrhs, afac,
582 $ ldafac, iwork, x, ldb, info )
587 $
CALL alaerh( path,
'CGBTRS', info, 0,
588 $ trans, n, n, kl, ku, -1,
589 $ imat, nfail, nerrs, nout )
591 CALL clacpy(
'Full', n, nrhs, b, ldb,
593 CALL cgbt02( trans, m, n, kl, ku, nrhs, a,
594 $ lda, x, ldb, work, ldb,
601 CALL cget04( n, nrhs, x, ldb, xact, ldb,
602 $ rcondc, result( 3 ) )
609 CALL cgbrfs( 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,
'CGBRFS', info, 0,
619 $ trans, n, n, kl, ku, nrhs,
620 $ imat, nfail, nerrs, nout )
622 CALL cget04( n, nrhs, x, ldb, xact, ldb,
623 $ rcondc, result( 4 ) )
624 CALL cgbt05( 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 cgbcon( norm, n, kl, ku, afac, ldafac,
662 $ iwork, anorm, rcond, work,
668 $
CALL alaerh( path,
'CGBCON', info, 0,
669 $ norm, n, n, kl, ku, -1, imat,
670 $ nfail, nerrs, nout )
672 result( 7 ) =
sget06( 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 CCHKGB, 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 CCHKGB, 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 $
',', 10x,
' type ', i1,
', test(', i1,
')=', g12.5 )
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine cgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
CGBTRF
subroutine cgbt02(TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, RESID)
CGBT02
subroutine cgbt01(M, N, KL, KU, A, LDA, AFAC, LDAFAC, IPIV, WORK, RESID)
CGBT01
real function sget06(RCOND, RCONDC)
SGET06
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine cgbt05(TRANS, N, KL, KU, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CGBT05
subroutine cgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, RWORK, INFO)
CGBCON
real function clangb(NORM, N, KL, KU, AB, LDAB, WORK)
CLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CGBRFS
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine cerrge(PATH, NUNIT)
CERRGE
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
subroutine cgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
CGBTRS
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM