169 SUBROUTINE clatdf( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV,
182 INTEGER ipiv( * ), jpiv( * )
183 COMPLEX rhs( * ), z( ldz, * )
190 parameter( maxdim = 2 )
192 parameter( zero = 0.0e+0, one = 1.0e+0 )
194 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
197 INTEGER i, info,
j, k
198 REAL rtemp, scale, sminu, splus
199 COMPLEX bm, bp, pmone, temp
203 COMPLEX work( 4*maxdim ), xm( maxdim ), xp( maxdim )
215 INTRINSIC abs,
REAL, sqrt
223 CALL
claswp( 1, rhs, ldz, 1, n-1, ipiv, 1 )
236 splus = splus +
REAL( CDOTC( N-J, Z( J+1, J ), 1, Z( J+1,
$ J ), 1 ) )
237 sminu =
REAL( CDOTC( N-J, Z( J+1, J ), 1, RHS( J+1 ), 1 ) )
238 splus = splus*
REAL( RHS( J ) )
239 IF( splus.GT.sminu )
THEN
241 ELSE IF( sminu.GT.splus )
THEN
251 rhs(
j ) = rhs(
j ) + pmone
258 CALL
caxpy( n-
j, temp, z(
j+1,
j ), 1, rhs(
j+1 ), 1 )
266 CALL
ccopy( n-1, rhs, 1, work, 1 )
267 work( n ) = rhs( n ) + cone
268 rhs( n ) = rhs( n ) - cone
272 temp = cone / z( i, i )
273 work( i ) = work( i )*temp
274 rhs( i ) = rhs( i )*temp
276 work( i ) = work( i ) - work( k )*( z( i, k )*temp )
277 rhs( i ) = rhs( i ) - rhs( k )*( z( i, k )*temp )
279 splus = splus + abs( work( i ) )
280 sminu = sminu + abs( rhs( i ) )
283 $ CALL
ccopy( n, work, 1, rhs, 1 )
287 CALL
claswp( 1, rhs, ldz, 1, n-1, jpiv, -1 )
291 CALL
classq( n, rhs, 1, rdscal, rdsum )
299 CALL
cgecon(
'I', n, z, ldz, one, rtemp, work, rwork, info )
300 CALL
ccopy( n, work( n+1 ), 1, xm, 1 )
304 CALL
claswp( 1, xm, ldz, 1, n-1, ipiv, -1 )
305 temp = cone / sqrt(
cdotc( n, xm, 1, xm, 1 ) )
306 CALL
cscal( n, temp, xm, 1 )
307 CALL
ccopy( n, xm, 1, xp, 1 )
308 CALL
caxpy( n, cone, rhs, 1, xp, 1 )
309 CALL
caxpy( n, -cone, xm, 1, rhs, 1 )
310 CALL
cgesc2( n, z, ldz, rhs, ipiv, jpiv, scale )
311 CALL
cgesc2( n, z, ldz, xp, ipiv, jpiv, scale )
313 $ CALL
ccopy( n, xp, 1, rhs, 1 )
317 CALL
classq( n, rhs, 1, rdscal, rdsum )
323 subroutine claswp(N, A, LDA, K1, K2, IPIV, INCX)
CLASWP performs a series of row interchanges on a general rectangular matrix.
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
real function scasum(N, CX, INCX)
SCASUM
complex function cdotc(N, CX, INCX, CY, INCY)
CDOTC
subroutine cgesc2(N, A, LDA, RHS, IPIV, JPIV, SCALE)
CGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed...
subroutine classq(N, X, INCX, SCALE, SUMSQ)
CLASSQ updates a sum of squares represented in scaled form.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
CGECON
subroutine clatdf(IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, JPIV)
CLATDF uses the LU factorization of the n-by-n matrix computed by sgetc2 and computes a contribution ...