138 SUBROUTINE dgbtrs( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB,
148 INTEGER info, kl, ku, ldab, ldb, n, nrhs
152 DOUBLE PRECISION ab( ldab, * ),
b( ldb, * )
159 parameter( one = 1.0d+0 )
162 LOGICAL lnoti, notran
163 INTEGER i,
j, kd, l, lm
180 notran =
lsame( trans,
'N' )
181 IF( .NOT.notran .AND. .NOT.
lsame( trans,
'T' ) .AND. .NOT.
182 $
lsame( trans,
'C' ) )
THEN
184 ELSE IF( n.LT.0 )
THEN
186 ELSE IF( kl.LT.0 )
THEN
188 ELSE IF( ku.LT.0 )
THEN
190 ELSE IF( nrhs.LT.0 )
THEN
192 ELSE IF( ldab.LT.( 2*kl+ku+1 ) )
THEN
194 ELSE IF( ldb.LT.max( 1, n ) )
THEN
198 CALL
xerbla(
'DGBTRS', -info )
204 IF( n.EQ.0 .OR. nrhs.EQ.0 )
226 $ CALL
dswap( nrhs,
b( l, 1 ), ldb,
b(
j, 1 ), ldb )
227 CALL
dger( lm, nrhs, -one, ab( kd+1,
j ), 1,
b(
j, 1 ),
228 $ ldb,
b(
j+1, 1 ), ldb )
236 CALL
dtbsv(
'Upper',
'No transpose',
'Non-unit', n, kl+ku,
237 $ ab, ldab,
b( 1, i ), 1 )
248 CALL
dtbsv(
'Upper',
'Transpose',
'Non-unit', n, kl+ku, ab,
249 $ ldab,
b( 1, i ), 1 )
255 DO 40
j = n - 1, 1, -1
257 CALL
dgemv(
'Transpose', lm, nrhs, -one,
b(
j+1, 1 ),
258 $ ldb, ab( kd+1,
j ), 1, one,
b(
j, 1 ), ldb )
261 $ CALL
dswap( nrhs,
b( l, 1 ), ldb,
b(
j, 1 ), ldb )
subroutine dtbsv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
DTBSV
subroutine dger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
DGER
LOGICAL function lsame(CA, CB)
LSAME
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine dgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
DGBTRS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV