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 )
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 scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
subroutine sgesc2(N, A, LDA, RHS, IPIV, JPIV, SCALE)
SGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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 ...
REAL function sasum(N, SX, INCX)
SASUM
subroutine sgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
SGECON
REAL function sdot(N, SX, INCX, SY, INCY)
SDOT
subroutine slaswp(N, A, LDA, K1, K2, IPIV, INCX)
SLASWP performs a series of row interchanges on a general rectangular matrix.
subroutine sscal(N, SA, SX, INCX)
SSCAL