190 SUBROUTINE schkgb( 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
206 INTEGER iwork( * ), mval( * ), nbval( * ), nsval( * ),
208 REAL a( * ), afac( * ),
b( * ), rwork( * ),
209 $ work( * ),
x( * ), xact( * )
216 parameter( one = 1.0e+0, zero = 0.0e+0 )
217 INTEGER ntypes, ntests
218 parameter( ntypes = 8, ntests = 7 )
220 parameter( nbw = 4, ntran = 3 )
223 LOGICAL trfcon, zerot
224 CHARACTER dist, norm, trans, type, xtype
226 INTEGER i, i1, i2, ikl, iku, im, imat, in, inb, info,
227 $ ioff, irhs, itran, izero,
j, k, kl, koff, ku,
228 $ lda, ldafac, ldb, m, mode, n, nb, nerrs, nfail,
229 $ nimat, nkl, nku, nrhs, nrun
230 REAL ainvnm, anorm, anormi, anormo, cndnum, rcond,
231 $ rcondc, rcondi, rcondo
234 CHARACTER transs( ntran )
235 INTEGER iseed( 4 ), iseedy( 4 ), klval( nbw ),
237 REAL result( ntests )
258 COMMON / infoc / infot, nunit, ok, lerr
259 COMMON / srnamc / srnamt
262 DATA iseedy / 1988, 1989, 1990, 1991 / ,
263 $ transs /
'N',
'T',
'C' /
269 path( 1: 1 ) =
'Single precision'
275 iseed( i ) = iseedy( i )
281 $ CALL
serrge( 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
slatb4( 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
slatms( m, n, dist, iseed, type, rwork,
395 $ mode, cndnum, anorm, kl, ku,
'Z',
396 $ a( koff ), lda, work, info )
401 CALL
alaerh( path,
'SLATMS', info, 0,
' ', m,
402 $ n, kl, ku, -1, imat, nfail,
406 ELSE IF( izero.GT.0 )
THEN
411 CALL
scopy( 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
scopy( 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
slacpy(
'Full', kl+ku+1, n, a, lda,
466 $ afac( kl+1 ), ldafac )
468 CALL
sgbtrf( m, n, kl, ku, afac, ldafac, iwork,
474 $ CALL
alaerh( path,
'SGBTRF', info, izero,
475 $
' ', m, n, kl, ku, nb, imat,
476 $ nfail, nerrs, nout )
483 CALL
sgbt01( 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 =
slangb(
'O', n, kl, ku, a, lda, rwork )
505 anormi =
slangb(
'I', n, kl, ku, a, lda, rwork )
513 CALL
slaset(
'Full', n, n, zero, one, work,
516 CALL
sgbtrs(
'No transpose', n, kl, ku, n,
517 $ afac, ldafac, iwork, work, ldb,
522 ainvnm =
slange(
'O', n, n, work, ldb,
524 IF( anormo.LE.zero .OR. ainvnm.LE.zero )
THEN
527 rcondo = ( one / anormo ) / ainvnm
533 ainvnm =
slange(
'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
slarhs( path, xtype,
' ', trans, n,
573 $ n, kl, ku, nrhs, a, lda,
574 $ xact, ldb,
b, ldb, iseed,
577 CALL
slacpy(
'Full', n, nrhs,
b, ldb,
x,
581 CALL
sgbtrs( trans, n, kl, ku, nrhs, afac,
582 $ ldafac, iwork,
x, ldb, info )
587 $ CALL
alaerh( path,
'SGBTRS', info, 0,
588 $ trans, n, n, kl, ku, -1,
589 $ imat, nfail, nerrs, nout )
591 CALL
slacpy(
'Full', n, nrhs,
b, ldb,
593 CALL
sgbt02( trans, m, n, kl, ku, nrhs, a,
594 $ lda,
x, ldb, work, ldb,
601 CALL
sget04( n, nrhs,
x, ldb, xact, ldb,
602 $ rcondc, result( 3 ) )
609 CALL
sgbrfs( trans, n, kl, ku, nrhs, a,
610 $ lda, afac, ldafac, iwork,
b,
611 $ ldb,
x, ldb, rwork,
612 $ rwork( nrhs+1 ), work,
613 $ iwork( n+1 ), info )
618 $ CALL
alaerh( path,
'SGBRFS', info, 0,
619 $ trans, n, n, kl, ku, nrhs,
620 $ imat, nfail, nerrs, nout )
622 CALL
sget04( n, nrhs,
x, ldb, xact, ldb,
623 $ rcondc, result( 4 ) )
624 CALL
sgbt05( trans, n, kl, ku, nrhs, a,
625 $ lda,
b, ldb,
x, ldb, xact,
626 $ ldb, rwork, rwork( nrhs+1 ),
629 IF( result( k ).GE.thresh )
THEN
630 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
631 $ CALL
alahd( nout, path )
632 WRITE( nout, fmt = 9996 )trans, n,
633 $ kl, ku, nrhs, imat, k,
647 IF( itran.EQ.1 )
THEN
657 CALL
sgbcon( norm, n, kl, ku, afac, ldafac,
658 $ iwork, anorm, rcond, work,
659 $ iwork( n+1 ), info )
664 $ CALL
alaerh( path,
'SGBCON', info, 0,
665 $ norm, n, n, kl, ku, -1, imat,
666 $ nfail, nerrs, nout )
668 result( 7 ) =
sget06( rcond, rcondc )
673 IF( result( 7 ).GE.thresh )
THEN
674 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
675 $ CALL
alahd( nout, path )
676 WRITE( nout, fmt = 9995 )norm, n, kl, ku,
677 $ imat, 7, result( 7 )
692 CALL
alasum( path, nout, nfail, nrun, nerrs )
694 9999
FORMAT(
' *** In SCHKGB, 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 SCHKGB, 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 $
',', 10
x,
' type ', i1,
', test(', i1,
')=', g12.5 )
subroutine serrge(PATH, NUNIT)
SERRGE
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine sgbt02(TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, RESID)
SGBT02
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
subroutine sget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
SGET04
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
REAL function slangb(NORM, N, KL, KU, AB, LDAB, WORK)
SLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine sgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
SGBTRF
REAL function sget06(RCOND, RCONDC)
SGET06
subroutine slarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
SLARHS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine sgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SGBCON
subroutine schkgb(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, A, LA, AFAC, LAFAC, B, X, XACT, WORK, RWORK, IWORK, NOUT)
SCHKGB
subroutine sgbt05(TRANS, N, KL, KU, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
SGBT05
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
REAL function slange(NORM, M, N, A, LDA, WORK)
SLANGE 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 sgbt01(M, N, KL, KU, A, LDA, AFAC, LDAFAC, IPIV, WORK, RESID)
SGBT01
subroutine sgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SGBRFS
subroutine sgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
SGBTRS
subroutine slatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
SLATB4