188 SUBROUTINE cchkgb( 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
203 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
206 COMPLEX A( * ), AFAC( * ), B( * ), WORK( * ), X( * ),
214 PARAMETER ( ONE = 1.0e+0, zero = 0.0e+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 REAL AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, RCOND,
229 $ RCONDC, RCONDI, RCONDO
232 CHARACTER TRANSS( NTRAN )
233 INTEGER ISEED( 4 ), ISEEDY( 4 ), KLVAL( NBW ),
235 REAL RESULT( NTESTS )
238 REAL CLANGB, CLANGE, SGET06
239 EXTERNAL CLANGB, CLANGE, SGET06
248 INTRINSIC cmplx, 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 ) =
'Complex precision'
273 iseed( i ) = iseedy( i )
279 $
CALL cerrge( 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 clatb4( 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 clatms( m, n, dist, iseed,
TYPE, rwork,
392 $ mode, cndnum, anorm, kl, ku,
'Z',
393 $ a( koff ), lda, work, info )
398 CALL alaerh( path,
'CLATMS', info, 0,
' ', m,
399 $ n, kl, ku, -1, imat, nfail,
403 ELSE IF( izero.GT.0 )
THEN
408 CALL ccopy( 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 ccopy( 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 clacpy(
'Full', kl+ku+1, n, a, lda,
463 $ afac( kl+1 ), ldafac )
465 CALL cgbtrf( m, n, kl, ku, afac, ldafac, iwork,
471 $
CALL alaerh( path,
'CGBTRF', info, izero,
472 $
' ', m, n, kl, ku, nb, imat,
473 $ nfail, nerrs, nout )
480 CALL cgbt01( 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 = clangb(
'O', n, kl, ku, a, lda, rwork )
502 anormi = clangb(
'I', n, kl, ku, a, lda, rwork )
510 CALL claset(
'Full', n, n, cmplx( zero ),
511 $ cmplx( one ), work, ldb )
513 CALL cgbtrs(
'No transpose', n, kl, ku, n,
514 $ afac, ldafac, iwork, work, ldb,
519 ainvnm = clange(
'O', n, n, work, ldb,
521 IF( anormo.LE.zero .OR. ainvnm.LE.zero )
THEN
524 rcondo = ( one / anormo ) / ainvnm
530 ainvnm = clange(
'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 clarhs( path, xtype,
' ', trans, n,
570 $ n, kl, ku, nrhs, a, lda,
571 $ xact, ldb, b, ldb, iseed,
574 CALL clacpy(
'Full', n, nrhs, b, ldb, x,
578 CALL cgbtrs( trans, n, kl, ku, nrhs, afac,
579 $ ldafac, iwork, x, ldb, info )
584 $
CALL alaerh( path,
'CGBTRS', info, 0,
585 $ trans, n, n, kl, ku, -1,
586 $ imat, nfail, nerrs, nout )
588 CALL clacpy(
'Full', n, nrhs, b, ldb,
590 CALL cgbt02( trans, m, n, kl, ku, nrhs, a,
591 $ lda, x, ldb, work, ldb,
592 $ rwork, result( 2 ) )
598 CALL cget04( n, nrhs, x, ldb, xact, ldb,
599 $ rcondc, result( 3 ) )
606 CALL cgbrfs( 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,
'CGBRFS', info, 0,
616 $ trans, n, n, kl, ku, nrhs,
617 $ imat, nfail, nerrs, nout )
619 CALL cget04( n, nrhs, x, ldb, xact, ldb,
620 $ rcondc, result( 4 ) )
621 CALL cgbt05( 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 cgbcon( norm, n, kl, ku, afac, ldafac,
659 $ iwork, anorm, rcond, work,
665 $
CALL alaerh( path,
'CGBCON', info, 0,
666 $ norm, n, n, kl, ku, -1, imat,
667 $ nfail, nerrs, nout )
669 result( 7 ) = sget06( 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 CCHKGB, 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 CCHKGB, 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 clarhs(path, xtype, uplo, trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, iseed, info)
CLARHS
subroutine xlaenv(ispec, nvalue)
XLAENV
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
subroutine alahd(iounit, path)
ALAHD
subroutine cchkgb(dotype, nm, mval, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, a, la, afac, lafac, b, x, xact, work, rwork, iwork, nout)
CCHKGB
subroutine cerrge(path, nunit)
CERRGE
subroutine cgbt01(m, n, kl, ku, a, lda, afac, ldafac, ipiv, work, resid)
CGBT01
subroutine cgbt02(trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, rwork, resid)
CGBT02
subroutine cgbt05(trans, n, kl, ku, nrhs, ab, ldab, b, ldb, x, ldx, xact, ldxact, ferr, berr, reslts)
CGBT05
subroutine cget04(n, nrhs, x, ldx, xact, ldxact, rcond, resid)
CGET04
subroutine clatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
CLATB4
subroutine clatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
CLATMS
subroutine ccopy(n, cx, incx, cy, incy)
CCOPY
subroutine cgbcon(norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond, work, rwork, info)
CGBCON
subroutine cgbrfs(trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CGBRFS
subroutine cgbtrf(m, n, kl, ku, ab, ldab, ipiv, info)
CGBTRF
subroutine cgbtrs(trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
CGBTRS
subroutine clacpy(uplo, m, n, a, lda, b, ldb)
CLACPY copies all or part of one two-dimensional array to another.
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.