120 SUBROUTINE cpbt01( UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK,
130 INTEGER kd, lda, ldafac, n
135 COMPLEX a( lda, * ), afac( ldafac, * )
143 parameter( zero = 0.0e+0, one = 1.0e+0 )
146 INTEGER i,
j, k, kc, klen, ml, mu
159 INTRINSIC aimag, max, min, real
173 anorm =
clanhb(
'1', uplo, n, kd, a, lda, rwork )
174 IF( anorm.LE.zero )
THEN
182 IF(
lsame( uplo,
'U' ) )
THEN
184 IF( aimag( afac( kd+1,
j ) ).NE.zero )
THEN
191 IF( aimag( afac( 1,
j ) ).NE.zero )
THEN
200 IF(
lsame( uplo,
'U' ) )
THEN
202 kc = max( 1, kd+2-k )
207 akk =
cdotc( klen+1, afac( kc, k ), 1, afac( kc, k ), 1 )
208 afac( kd+1, k ) = akk
213 $ CALL
ctrmv(
'Upper',
'Conjugate',
'Non-unit', klen,
214 $ afac( kd+1, k-klen ), ldafac-1,
223 klen = min( kd, n-k )
229 $ CALL
cher(
'Lower', klen, one, afac( 2, k ), 1,
230 $ afac( 1, k+1 ), ldafac-1 )
235 CALL
csscal( klen+1, akk, afac( 1, k ), 1 )
242 IF(
lsame( uplo,
'U' ) )
THEN
244 mu = max( 1, kd+2-
j )
246 afac( i,
j ) = afac( i,
j ) - a( i,
j )
251 ml = min( kd+1, n-
j+1 )
253 afac( i,
j ) = afac( i,
j ) - a( i,
j )
260 resid =
clanhb(
'1', uplo, n, kd, afac, ldafac, rwork )
262 resid = ( ( resid /
REAL( N ) ) / anorm ) / eps
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
subroutine cher(UPLO, N, ALPHA, X, INCX, A, LDA)
CHER
COMPLEX function cdotc(N, CX, INCX, CY, INCY)
CDOTC
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine cpbt01(UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK, RESID)
CPBT01
REAL function clanhb(NORM, UPLO, N, K, AB, LDAB, WORK)
CLANHB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a Hermitian band matrix.
subroutine ctrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
CTRMV
subroutine csscal(N, SA, CX, INCX)
CSSCAL