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 zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zlaswp(N, A, LDA, K1, K2, IPIV, INCX)
ZLASWP performs a series of row interchanges on a general rectangular matrix.
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 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 zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL