150 SUBROUTINE chbt21( UPLO, N, KA, KS, A, LDA, D, E, U, LDU, WORK,
160 INTEGER ka, ks, lda, ldu, n
163 REAL d( * ), e( * ), result( 2 ), rwork( * )
164 COMPLEX a( lda, * ), u( ldu, * ), work( * )
171 parameter( czero = ( 0.0e+0, 0.0e+0 ),
172 $ cone = ( 1.0e+0, 0.0e+0 ) )
174 parameter( zero = 0.0e+0, one = 1.0e+0 )
179 INTEGER ika,
j, jc, jr
180 REAL anorm, ulp, unfl, wnorm
191 INTRINSIC cmplx, max, min, real
202 ika = max( 0, min( n-1, ka ) )
204 IF(
lsame( uplo,
'U' ) )
THEN
212 unfl =
slamch(
'Safe minimum' )
221 anorm = max(
clanhb(
'1', cuplo, n, ika, a, lda, rwork ), unfl )
230 DO 10 jr = 1, min( ika+1, n+1-jc )
232 work(
j ) = a( jr, jc )
234 DO 20 jr = ika + 2, n + 1 - jc
239 DO 30 jr = ika + 2, jc
243 DO 40 jr = min( ika, jc-1 ), 0, -1
245 work(
j ) = a( ika+1-jr, jc )
251 CALL
chpr( cuplo, n, -d(
j ), u( 1,
j ), 1, work )
254 IF( n.GT.1 .AND. ks.EQ.1 )
THEN
256 CALL
chpr2( cuplo, n, -cmplx( e(
j ) ), u( 1,
j ), 1,
257 $ u( 1,
j+1 ), 1, work )
260 wnorm =
clanhp(
'1', cuplo, n, work, rwork )
262 IF( anorm.GT.wnorm )
THEN
263 result( 1 ) = ( wnorm / anorm ) / ( n*ulp )
265 IF( anorm.LT.one )
THEN
266 result( 1 ) = ( min( wnorm, n*anorm ) / anorm ) / ( n*ulp )
268 result( 1 ) = min( wnorm / anorm,
REAL( N ) ) / ( n*ulp )
276 CALL
cgemm(
'N',
'C', n, n, n, cone, u, ldu, u, ldu, czero, work,
280 work( ( n+1 )*(
j-1 )+1 ) = work( ( n+1 )*(
j-1 )+1 ) - cone
283 result( 2 ) = min(
clange(
'1', n, n, work, n, rwork ),
284 $
REAL( N ) ) / ( n*ulp )
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 chbt21(UPLO, N, KA, KS, A, LDA, D, E, U, LDU, WORK, RWORK, RESULT)
CHBT21
real function clanhp(NORM, UPLO, N, AP, WORK)
CLANHP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix supplied in packed form.
subroutine chpr(UPLO, N, ALPHA, X, INCX, AP)
CHPR
subroutine chpr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
CHPR2
logical function lsame(CA, CB)
LSAME
real function slamch(CMACH)
SLAMCH
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.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM