171 SUBROUTINE dlatdf( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV,
181 DOUBLE PRECISION rdscal, rdsum
184 INTEGER ipiv( * ), jpiv( * )
185 DOUBLE PRECISION rhs( * ), z( ldz, * )
192 parameter( maxdim = 8 )
193 DOUBLE PRECISION zero, one
194 parameter( zero = 0.0d+0, one = 1.0d+0 )
197 INTEGER i, info, j, k
198 DOUBLE PRECISION bm, bp, pmone, sminu, splus, temp
201 INTEGER iwork( maxdim )
202 DOUBLE PRECISION work( 4*maxdim ), xm( maxdim ), xp( maxdim )
221 CALL
dlaswp( 1, rhs, ldz, 1, n-1, ipiv, 1 )
235 splus = splus +
ddot( n-j, z( j+1, j ), 1, z( j+1, j ), 1 )
236 sminu =
ddot( n-j, z( j+1, j ), 1, rhs( j+1 ), 1 )
237 splus = splus*rhs( j )
238 IF( splus.GT.sminu )
THEN
240 ELSE IF( sminu.GT.splus )
THEN
250 rhs( j ) = rhs( j ) + pmone
257 CALL
daxpy( n-j, temp, z( j+1, j ), 1, rhs( j+1 ), 1 )
266 CALL
dcopy( n-1, rhs, 1, xp, 1 )
267 xp( n ) = rhs( n ) + one
268 rhs( n ) = rhs( n ) - one
272 temp = one / z( i, i )
273 xp( i ) = xp( i )*temp
274 rhs( i ) = rhs( i )*temp
276 xp( i ) = xp( i ) - xp( k )*( z( i, k )*temp )
277 rhs( i ) = rhs( i ) - rhs( k )*( z( i, k )*temp )
279 splus = splus + abs( xp( i ) )
280 sminu = sminu + abs( rhs( i ) )
283 $ CALL
dcopy( n, xp, 1, rhs, 1 )
287 CALL
dlaswp( 1, rhs, ldz, 1, n-1, jpiv, -1 )
291 CALL
dlassq( n, rhs, 1, rdscal, rdsum )
297 CALL
dgecon(
'I', n, z, ldz, one, temp, work, iwork, info )
298 CALL
dcopy( n, work( n+1 ), 1, xm, 1 )
302 CALL
dlaswp( 1, xm, ldz, 1, n-1, ipiv, -1 )
303 temp = one / sqrt(
ddot( n, xm, 1, xm, 1 ) )
304 CALL
dscal( n, temp, xm, 1 )
305 CALL
dcopy( n, xm, 1, xp, 1 )
306 CALL
daxpy( n, one, rhs, 1, xp, 1 )
307 CALL
daxpy( n, -one, xm, 1, rhs, 1 )
308 CALL
dgesc2( n, z, ldz, rhs, ipiv, jpiv, temp )
309 CALL
dgesc2( n, z, ldz, xp, ipiv, jpiv, temp )
311 $ CALL
dcopy( n, xp, 1, rhs, 1 )
315 CALL
dlassq( n, rhs, 1, rdscal, rdsum )