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 )
209 DOUBLE PRECISION DASUM, DDOT
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 )
310 IF( dasum( n, xp, 1 ).GT.dasum( n, rhs, 1 ) )
311 $ CALL
dcopy( n, xp, 1, rhs, 1 )
315 CALL
dlassq( n, rhs, 1, rdscal, rdsum )
subroutine dgesc2(N, A, LDA, RHS, IPIV, JPIV, SCALE)
DGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed...
subroutine dgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
DGECON
subroutine dlaswp(N, A, LDA, K1, K2, IPIV, INCX)
DLASWP performs a series of row interchanges on a general rectangular matrix.
subroutine dlatdf(IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, JPIV)
DLATDF uses the LU factorization of the n-by-n matrix computed by sgetc2 and computes a contribution ...
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dlassq(N, X, INCX, SCALE, SUMSQ)
DLASSQ updates a sum of squares represented in scaled form.
subroutine daxpy(N, DA, DX, INCX, DY, INCY)
DAXPY