167 SUBROUTINE clatdf( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV,
179 INTEGER IPIV( * ), JPIV( * )
180 COMPLEX RHS( * ), Z( LDZ, * )
187 parameter( maxdim = 2 )
189 parameter( zero = 0.0e+0, one = 1.0e+0 )
191 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
194 INTEGER I, INFO, J, K
195 REAL RTEMP, SCALE, SMINU, SPLUS
196 COMPLEX BM, BP, PMONE, TEMP
200 COMPLEX WORK( 4*MAXDIM ), XM( MAXDIM ), XP( MAXDIM )
209 EXTERNAL scasum, cdotc
212 INTRINSIC abs, real, sqrt
220 CALL claswp( 1, rhs, ldz, 1, n-1, ipiv, 1 )
233 splus = splus + real( cdotc( n-j, z( j+1, j ), 1, z( j+1,
235 sminu = real( cdotc( n-j, z( j+1, j ), 1, rhs( j+1 ), 1 ) )
236 splus = splus*real( rhs( j ) )
237 IF( splus.GT.sminu )
THEN
239 ELSE IF( sminu.GT.splus )
THEN
249 rhs( j ) = rhs( j ) + pmone
256 CALL caxpy( n-j, temp, z( j+1, j ), 1, rhs( j+1 ), 1 )
264 CALL ccopy( n-1, rhs, 1, work, 1 )
265 work( n ) = rhs( n ) + cone
266 rhs( n ) = rhs( n ) - cone
270 temp = cone / z( i, i )
271 work( i ) = work( i )*temp
272 rhs( i ) = rhs( i )*temp
274 work( i ) = work( i ) - work( k )*( z( i, k )*temp )
275 rhs( i ) = rhs( i ) - rhs( k )*( z( i, k )*temp )
277 splus = splus + abs( work( i ) )
278 sminu = sminu + abs( rhs( i ) )
281 $
CALL ccopy( n, work, 1, rhs, 1 )
285 CALL claswp( 1, rhs, ldz, 1, n-1, jpiv, -1 )
289 CALL classq( n, rhs, 1, rdscal, rdsum )
297 CALL cgecon(
'I', n, z, ldz, one, rtemp, work, rwork, info )
298 CALL ccopy( n, work( n+1 ), 1, xm, 1 )
302 CALL claswp( 1, xm, ldz, 1, n-1, ipiv, -1 )
303 temp = cone / sqrt( cdotc( n, xm, 1, xm, 1 ) )
304 CALL cscal( n, temp, xm, 1 )
305 CALL ccopy( n, xm, 1, xp, 1 )
306 CALL caxpy( n, cone, rhs, 1, xp, 1 )
307 CALL caxpy( n, -cone, xm, 1, rhs, 1 )
308 CALL cgesc2( n, z, ldz, rhs, ipiv, jpiv, scale )
309 CALL cgesc2( n, z, ldz, xp, ipiv, jpiv, scale )
310 IF( scasum( n, xp, 1 ).GT.scasum( n, rhs, 1 ) )
311 $
CALL ccopy( n, xp, 1, rhs, 1 )
315 CALL classq( n, rhs, 1, rdscal, rdsum )
subroutine caxpy(n, ca, cx, incx, cy, incy)
CAXPY
subroutine ccopy(n, cx, incx, cy, incy)
CCOPY
subroutine cgecon(norm, n, a, lda, anorm, rcond, work, rwork, info)
CGECON
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.
subroutine claswp(n, a, lda, k1, k2, ipiv, incx)
CLASWP performs a series of row interchanges on a general rectangular matrix.
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 ...
subroutine cscal(n, ca, cx, incx)
CSCAL