169 SUBROUTINE zlatdf( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV,
179 DOUBLE PRECISION RDSCAL, RDSUM
182 INTEGER IPIV( * ), JPIV( * )
183 COMPLEX*16 RHS( * ), Z( ldz, * )
190 parameter( maxdim = 2 )
191 DOUBLE PRECISION ZERO, ONE
192 parameter( zero = 0.0d+0, one = 1.0d+0 )
194 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
197 INTEGER I, INFO, J, K
198 DOUBLE PRECISION RTEMP, SCALE, SMINU, SPLUS
199 COMPLEX*16 BM, BP, PMONE, TEMP
202 DOUBLE PRECISION RWORK( maxdim )
203 COMPLEX*16 WORK( 4*maxdim ), XM( maxdim ), XP( maxdim )
210 DOUBLE PRECISION DZASUM
212 EXTERNAL dzasum, zdotc
215 INTRINSIC abs, dble, sqrt
223 CALL zlaswp( 1, rhs, ldz, 1, n-1, ipiv, 1 )
236 splus = splus + dble( zdotc( n-j, z( j+1, j ), 1, z( j+1,
238 sminu = dble( zdotc( n-j, z( j+1, j ), 1, rhs( j+1 ), 1 ) )
239 splus = splus*dble( rhs( j ) )
240 IF( splus.GT.sminu )
THEN
242 ELSE IF( sminu.GT.splus )
THEN
252 rhs( j ) = rhs( j ) + pmone
259 CALL zaxpy( n-j, temp, z( j+1, j ), 1, rhs( j+1 ), 1 )
267 CALL zcopy( n-1, rhs, 1, work, 1 )
268 work( n ) = rhs( n ) + cone
269 rhs( n ) = rhs( n ) - cone
273 temp = cone / z( i, i )
274 work( i ) = work( i )*temp
275 rhs( i ) = rhs( i )*temp
277 work( i ) = work( i ) - work( k )*( z( i, k )*temp )
278 rhs( i ) = rhs( i ) - rhs( k )*( z( i, k )*temp )
280 splus = splus + abs( work( i ) )
281 sminu = sminu + abs( rhs( i ) )
284 $
CALL zcopy( n, work, 1, rhs, 1 )
288 CALL zlaswp( 1, rhs, ldz, 1, n-1, jpiv, -1 )
292 CALL zlassq( n, rhs, 1, rdscal, rdsum )
300 CALL zgecon(
'I', n, z, ldz, one, rtemp, work, rwork, info )
301 CALL zcopy( n, work( n+1 ), 1, xm, 1 )
305 CALL zlaswp( 1, xm, ldz, 1, n-1, ipiv, -1 )
306 temp = cone / sqrt( zdotc( n, xm, 1, xm, 1 ) )
307 CALL zscal( n, temp, xm, 1 )
308 CALL zcopy( n, xm, 1, xp, 1 )
309 CALL zaxpy( n, cone, rhs, 1, xp, 1 )
310 CALL zaxpy( n, -cone, xm, 1, rhs, 1 )
311 CALL zgesc2( n, z, ldz, rhs, ipiv, jpiv, scale )
312 CALL zgesc2( n, z, ldz, xp, ipiv, jpiv, scale )
313 IF( dzasum( n, xp, 1 ).GT.dzasum( n, rhs, 1 ) )
314 $
CALL zcopy( n, xp, 1, rhs, 1 )
318 CALL zlassq( n, rhs, 1, rdscal, rdsum )
subroutine zlassq(N, X, INCX, SCALE, SUMSQ)
ZLASSQ updates a sum of squares represented in scaled form.
subroutine zgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
ZGECON
subroutine zgesc2(N, A, LDA, RHS, IPIV, JPIV, SCALE)
ZGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed...
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zlatdf(IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, JPIV)
ZLATDF uses the LU factorization of the n-by-n matrix computed by sgetc2 and computes a contribution ...
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
subroutine zlaswp(N, A, LDA, K1, K2, IPIV, INCX)
ZLASWP performs a series of row interchanges on a general rectangular matrix.
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL