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