cgetc2()

subroutine cgetc2	(	integer	n,
		complex, dimension( lda, * )	a,
		integer	lda,
		integer, dimension( * )	ipiv,
		integer, dimension( * )	jpiv,
		integer	info )

CGETC2 computes the LU factorization with complete pivoting of the general n-by-n matrix.

Download CGETC2 + dependencies [TGZ] [ZIP] [TXT]

Purpose:

!>
!> CGETC2 computes an LU factorization, using complete pivoting, of the
!> n-by-n matrix A. The factorization has the form A = P * L * U * Q,
!> where P and Q are permutation matrices, L is lower triangular with
!> unit diagonal elements and U is upper triangular.
!>
!> This is a level 1 BLAS version of the algorithm.
!> 

Parameters

[in]	N	!> N is INTEGER !> The order of the matrix A. N >= 0. !>
[in,out]	A	!> A is COMPLEX array, dimension (LDA, N) !> On entry, the n-by-n matrix to be factored. !> On exit, the factors L and U from the factorization !> A = P*L*U*Q; the unit diagonal elements of L are not stored. !> If U(k, k) appears to be less than SMIN, U(k, k) is given the !> value of SMIN, giving a nonsingular perturbed system. !>
[in]	LDA	!> LDA is INTEGER !> The leading dimension of the array A. LDA >= max(1, N). !>
[out]	IPIV	!> IPIV is INTEGER array, dimension (N). !> The pivot indices; for 1 <= i <= N, row i of the !> matrix has been interchanged with row IPIV(i). !>
[out]	JPIV	!> JPIV is INTEGER array, dimension (N). !> The pivot indices; for 1 <= j <= N, column j of the !> matrix has been interchanged with column JPIV(j). !>
[out]	INFO	!> INFO is INTEGER !> = 0: successful exit !> > 0: if INFO = k, U(k, k) is likely to produce overflow if !> one tries to solve for x in Ax = b. So U is perturbed !> to avoid the overflow. !>

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Contributors:

Bo Kagstrom and Peter Poromaa, Department of Computing Science, Umea University, S-901 87 Umea, Sweden.

Definition at line 108 of file cgetc2.f.

*
*  -- LAPACK auxiliary routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      INTEGER            INFO, LDA, N
*     ..
*     .. Array Arguments ..
      INTEGER            IPIV( * ), JPIV( * )
      COMPLEX            A( LDA, * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ZERO, ONE
      parameter( zero = 0.0e+0, one = 1.0e+0 )
*     ..
*     .. Local Scalars ..
      INTEGER            I, IP, IPV, J, JP, JPV
      REAL               BIGNUM, EPS, SMIN, SMLNUM, XMAX
*     ..
*     .. External Subroutines ..
      EXTERNAL           cgeru, cswap
*     ..
*     .. External Functions ..
      REAL               SLAMCH
      EXTERNAL           slamch
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, cmplx, max
*     ..
*     .. Executable Statements ..
*
      info = 0
*
*     Quick return if possible
*
      IF( n.EQ.0 )
     $   RETURN
*
*     Set constants to control overflow
*
      eps = slamch( 'P' )
      smlnum = slamch( 'S' ) / eps
      bignum = one / smlnum
*
*     Handle the case N=1 by itself
*
      IF( n.EQ.1 ) THEN
         ipiv( 1 ) = 1
         jpiv( 1 ) = 1
         IF( abs( a( 1, 1 ) ).LT.smlnum ) THEN
            info = 1
            a( 1, 1 ) = cmplx( smlnum, zero )
         END IF
         RETURN
      END IF
*
*     Factorize A using complete pivoting.
*     Set pivots less than SMIN to SMIN
*
      DO 40 i = 1, n - 1
*
*        Find max element in matrix A
*
         xmax = zero
         DO 20 jp = i, n
            DO 10 ip = i, n
               IF( abs( a( ip, jp ) ).GE.xmax ) THEN
                  xmax = abs( a( ip, jp ) )
                  ipv = ip
                  jpv = jp
               END IF
   10       CONTINUE
   20    CONTINUE
         IF( i.EQ.1 )
     $      smin = max( eps*xmax, smlnum )
*
*        Swap rows
*
         IF( ipv.NE.i )
     $      CALL cswap( n, a( ipv, 1 ), lda, a( i, 1 ), lda )
         ipiv( i ) = ipv
*
*        Swap columns
*
         IF( jpv.NE.i )
     $      CALL cswap( n, a( 1, jpv ), 1, a( 1, i ), 1 )
         jpiv( i ) = jpv
*
*        Check for singularity
*
         IF( abs( a( i, i ) ).LT.smin ) THEN
            info = i
            a( i, i ) = cmplx( smin, zero )
         END IF
         DO 30 j = i + 1, n
            a( j, i ) = a( j, i ) / a( i, i )
   30    CONTINUE
         CALL cgeru( n-i, n-i, -cmplx( one ), a( i+1, i ), 1,
     $               a( i, i+1 ), lda, a( i+1, i+1 ), lda )
   40 CONTINUE
*
      IF( abs( a( n, n ) ).LT.smin ) THEN
         info = n
         a( n, n ) = cmplx( smin, zero )
      END IF
*
*     Set last pivots to N
*
      ipiv( n ) = n
      jpiv( n ) = n
*
      RETURN
*
*     End of CGETC2
*

Here is the call graph for this function:

Here is the caller graph for this function: