139 SUBROUTINE dbdt01( M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK,
147 INTEGER KD, LDA, LDPT, LDQ, M, N
148 DOUBLE PRECISION RESID
151 DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), PT( LDPT, * ),
152 $ q( ldq, * ), work( * )
158 DOUBLE PRECISION ZERO, ONE
159 parameter( zero = 0.0d+0, one = 1.0d+0 )
163 DOUBLE PRECISION ANORM, EPS
166 DOUBLE PRECISION DASUM, DLAMCH, DLANGE
167 EXTERNAL dasum, dlamch, dlange
173 INTRINSIC dble, max, min
179 IF( m.LE.0 .OR. n.LE.0 )
THEN
191 IF( kd.NE.0 .AND. m.GE.n )
THEN
196 CALL dcopy( m, a( 1, j ), 1, work, 1 )
198 work( m+i ) = d( i )*pt( i, j ) + e( i )*pt( i+1, j )
200 work( m+n ) = d( n )*pt( n, j )
201 CALL dgemv(
'No transpose', m, n, -one, q, ldq,
202 $ work( m+1 ), 1, one, work, 1 )
203 resid = max( resid, dasum( m, work, 1 ) )
205 ELSE IF( kd.LT.0 )
THEN
210 CALL dcopy( m, a( 1, j ), 1, work, 1 )
212 work( m+i ) = d( i )*pt( i, j ) + e( i )*pt( i+1, j )
214 work( m+m ) = d( m )*pt( m, j )
215 CALL dgemv(
'No transpose', m, m, -one, q, ldq,
216 $ work( m+1 ), 1, one, work, 1 )
217 resid = max( resid, dasum( m, work, 1 ) )
224 CALL dcopy( m, a( 1, j ), 1, work, 1 )
225 work( m+1 ) = d( 1 )*pt( 1, j )
227 work( m+i ) = e( i-1 )*pt( i-1, j ) +
230 CALL dgemv(
'No transpose', m, m, -one, q, ldq,
231 $ work( m+1 ), 1, one, work, 1 )
232 resid = max( resid, dasum( m, work, 1 ) )
241 CALL dcopy( m, a( 1, j ), 1, work, 1 )
243 work( m+i ) = d( i )*pt( i, j )
245 CALL dgemv(
'No transpose', m, n, -one, q, ldq,
246 $ work( m+1 ), 1, one, work, 1 )
247 resid = max( resid, dasum( m, work, 1 ) )
251 CALL dcopy( m, a( 1, j ), 1, work, 1 )
253 work( m+i ) = d( i )*pt( i, j )
255 CALL dgemv(
'No transpose', m, m, -one, q, ldq,
256 $ work( m+1 ), 1, one, work, 1 )
257 resid = max( resid, dasum( m, work, 1 ) )
264 anorm = dlange(
'1', m, n, a, lda, work )
265 eps = dlamch(
'Precision' )
267 IF( anorm.LE.zero )
THEN
271 IF( anorm.GE.resid )
THEN
272 resid = ( resid / anorm ) / ( dble( n )*eps )
274 IF( anorm.LT.one )
THEN
275 resid = ( min( resid, dble( n )*anorm ) / anorm ) /
278 resid = min( resid / anorm, dble( n ) ) /
subroutine dbdt01(m, n, kd, a, lda, q, ldq, d, e, pt, ldpt, work, resid)
DBDT01
subroutine dcopy(n, dx, incx, dy, incy)
DCOPY
subroutine dgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
DGEMV