146 SUBROUTINE cbdt01( M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK,
155 INTEGER kd, lda, ldpt, ldq, m, n
159 REAL d( * ), e( * ), rwork( * )
160 COMPLEX a( lda, * ), pt( ldpt, * ), q( ldq, * ),
168 parameter( zero = 0.0e+0, one = 1.0e+0 )
182 INTRINSIC cmplx, max, min, real
188 IF( m.LE.0 .OR. n.LE.0 )
THEN
200 IF( kd.NE.0 .AND. m.GE.n )
THEN
205 CALL
ccopy( m, a( 1,
j ), 1, work, 1 )
207 work( m+i ) = d( i )*pt( i,
j ) + e( i )*pt( i+1,
j )
209 work( m+n ) = d( n )*pt( n,
j )
210 CALL
cgemv(
'No transpose', m, n, -cmplx( one ), q, ldq,
211 $ work( m+1 ), 1, cmplx( one ), work, 1 )
212 resid = max( resid,
scasum( m, work, 1 ) )
214 ELSE IF( kd.LT.0 )
THEN
219 CALL
ccopy( m, a( 1,
j ), 1, work, 1 )
221 work( m+i ) = d( i )*pt( i,
j ) + e( i )*pt( i+1,
j )
223 work( m+m ) = d( m )*pt( m,
j )
224 CALL
cgemv(
'No transpose', m, m, -cmplx( one ), q, ldq,
225 $ work( m+1 ), 1, cmplx( one ), work, 1 )
226 resid = max( resid,
scasum( m, work, 1 ) )
233 CALL
ccopy( m, a( 1,
j ), 1, work, 1 )
234 work( m+1 ) = d( 1 )*pt( 1,
j )
236 work( m+i ) = e( i-1 )*pt( i-1,
j ) +
239 CALL
cgemv(
'No transpose', m, m, -cmplx( one ), q, ldq,
240 $ work( m+1 ), 1, cmplx( one ), work, 1 )
241 resid = max( resid,
scasum( m, work, 1 ) )
250 CALL
ccopy( m, a( 1,
j ), 1, work, 1 )
252 work( m+i ) = d( i )*pt( i,
j )
254 CALL
cgemv(
'No transpose', m, n, -cmplx( one ), q, ldq,
255 $ work( m+1 ), 1, cmplx( one ), work, 1 )
256 resid = max( resid,
scasum( m, work, 1 ) )
260 CALL
ccopy( m, a( 1,
j ), 1, work, 1 )
262 work( m+i ) = d( i )*pt( i,
j )
264 CALL
cgemv(
'No transpose', m, m, -cmplx( one ), q, ldq,
265 $ work( m+1 ), 1, cmplx( one ), work, 1 )
266 resid = max( resid,
scasum( m, work, 1 ) )
273 anorm =
clange(
'1', m, n, a, lda, rwork )
274 eps =
slamch(
'Precision' )
276 IF( anorm.LE.zero )
THEN
280 IF( anorm.GE.resid )
THEN
281 resid = ( resid / anorm ) / (
REAL( n )*eps )
283 IF( anorm.LT.one )
THEN
284 resid = ( min( resid,
REAL( n )*anorm ) / anorm ) /
287 resid = min( resid / anorm,
REAL( N ) ) /
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 cbdt01(M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK, RWORK, RESID)
CBDT01
real function scasum(N, CX, INCX)
SCASUM
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
real function slamch(CMACH)
SLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY