171 SUBROUTINE slatdf( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV,
184 INTEGER IPIV( * ), JPIV( * )
185 REAL RHS( * ), Z( ldz, * )
192 parameter ( maxdim = 8 )
194 parameter ( zero = 0.0e+0, one = 1.0e+0 )
197 INTEGER I, INFO, J, K
198 REAL BM, BP, PMONE, SMINU, SPLUS, TEMP
201 INTEGER IWORK( maxdim )
202 REAL WORK( 4*maxdim ), XM( maxdim ), XP( maxdim )
221 CALL slaswp( 1, rhs, ldz, 1, n-1, ipiv, 1 )
235 splus = splus + sdot( n-j, z( j+1, j ), 1, z( j+1, j ), 1 )
236 sminu = sdot( 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 saxpy( n-j, temp, z( j+1, j ), 1, rhs( j+1 ), 1 )
266 CALL scopy( 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 scopy( n, xp, 1, rhs, 1 )
287 CALL slaswp( 1, rhs, ldz, 1, n-1, jpiv, -1 )
291 CALL slassq( n, rhs, 1, rdscal, rdsum )
297 CALL sgecon(
'I', n, z, ldz, one, temp, work, iwork, info )
298 CALL scopy( n, work( n+1 ), 1, xm, 1 )
302 CALL slaswp( 1, xm, ldz, 1, n-1, ipiv, -1 )
303 temp = one / sqrt( sdot( n, xm, 1, xm, 1 ) )
304 CALL sscal( n, temp, xm, 1 )
305 CALL scopy( n, xm, 1, xp, 1 )
306 CALL saxpy( n, one, rhs, 1, xp, 1 )
307 CALL saxpy( n, -one, xm, 1, rhs, 1 )
308 CALL sgesc2( n, z, ldz, rhs, ipiv, jpiv, temp )
309 CALL sgesc2( n, z, ldz, xp, ipiv, jpiv, temp )
310 IF( sasum( n, xp, 1 ).GT.sasum( n, rhs, 1 ) )
311 $
CALL scopy( n, xp, 1, rhs, 1 )
315 CALL slassq( n, rhs, 1, rdscal, rdsum )
subroutine slassq(N, X, INCX, SCALE, SUMSQ)
SLASSQ updates a sum of squares represented in scaled form.
subroutine slatdf(IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, JPIV)
SLATDF uses the LU factorization of the n-by-n matrix computed by sgetc2 and computes a contribution ...
subroutine sgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
SGECON
subroutine slaswp(N, A, LDA, K1, K2, IPIV, INCX)
SLASWP performs a series of row interchanges on a general rectangular matrix.
subroutine sgesc2(N, A, LDA, RHS, IPIV, JPIV, SCALE)
SGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed...
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY