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 )
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 )
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
DOUBLE PRECISION function dzasum(N, ZX, INCX)
DZASUM
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
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zlaswp(N, A, LDA, K1, K2, IPIV, INCX)
ZLASWP performs a series of row interchanges on a general rectangular matrix.
COMPLEX *16 function zdotc(N, ZX, INCX, ZY, INCY)
ZDOTC
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL