114 SUBROUTINE cgesc2( N, A, LDA, RHS, IPIV, JPIV, SCALE )
125 INTEGER IPIV( * ), JPIV( * )
126 COMPLEX A( LDA, * ), RHS( * )
133 parameter( zero = 0.0e+0, one = 1.0e+0, two = 2.0e+0 )
137 REAL BIGNUM, EPS, SMLNUM
146 EXTERNAL icamax, slamch
149 INTRINSIC abs, cmplx, real
156 smlnum = slamch(
'S' ) / eps
157 bignum = one / smlnum
158 CALL slabad( smlnum, bignum )
162 CALL claswp( 1, rhs, lda, 1, n-1, ipiv, 1 )
168 rhs( j ) = rhs( j ) - a( j, i )*rhs( i )
178 i = icamax( n, rhs, 1 )
179 IF( two*smlnum*abs( rhs( i ) ).GT.abs( a( n, n ) ) )
THEN
180 temp = cmplx( one / two, zero ) / abs( rhs( i ) )
181 CALL cscal( n, temp, rhs( 1 ), 1 )
182 scale = scale*real( temp )
185 temp = cmplx( one, zero ) / a( i, i )
186 rhs( i ) = rhs( i )*temp
188 rhs( i ) = rhs( i ) - rhs( j )*( a( i, j )*temp )
194 CALL claswp( 1, rhs, lda, 1, n-1, jpiv, -1 )
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine cscal(N, CA, CX, INCX)
CSCAL
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 claswp(N, A, LDA, K1, K2, IPIV, INCX)
CLASWP performs a series of row interchanges on a general rectangular matrix.