165 SUBROUTINE clatdf( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV,
177 INTEGER IPIV( * ), JPIV( * )
178 COMPLEX RHS( * ), Z( LDZ, * )
185 parameter( maxdim = 2 )
187 parameter( zero = 0.0e+0, one = 1.0e+0 )
189 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
192 INTEGER I, INFO, J, K
193 REAL RTEMP, SCALE, SMINU, SPLUS
194 COMPLEX BM, BP, PMONE, TEMP
198 COMPLEX WORK( 4*MAXDIM ), XM( MAXDIM ), XP( MAXDIM )
208 EXTERNAL scasum, cdotc
211 INTRINSIC abs, real, sqrt
219 CALL claswp( 1, rhs, ldz, 1, n-1, ipiv, 1 )
232 splus = splus + real( cdotc( n-j, z( j+1, j ), 1, z( j+1,
234 sminu = real( cdotc( n-j, z( j+1, j ), 1, rhs( j+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 )