File:  [local] / rpl / lapack / lapack / zgetc2.f
Revision 1.12: download - view: text, annotated - select for diffs - revision graph
Fri Dec 14 14:22:45 2012 UTC (11 years, 5 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_16, rpl-4_1_15, rpl-4_1_14, rpl-4_1_13, rpl-4_1_12, rpl-4_1_11, HEAD
Mise à jour de lapack.

    1: *> \brief \b ZGETC2 computes the LU factorization with complete pivoting of the general n-by-n matrix.
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at 
    6: *            http://www.netlib.org/lapack/explore-html/ 
    7: *
    8: *> \htmlonly
    9: *> Download ZGETC2 + dependencies 
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgetc2.f"> 
   11: *> [TGZ]</a> 
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgetc2.f"> 
   13: *> [ZIP]</a> 
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgetc2.f"> 
   15: *> [TXT]</a>
   16: *> \endhtmlonly 
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE ZGETC2( N, A, LDA, IPIV, JPIV, INFO )
   22:    23: *       .. Scalar Arguments ..
   24: *       INTEGER            INFO, LDA, N
   25: *       ..
   26: *       .. Array Arguments ..
   27: *       INTEGER            IPIV( * ), JPIV( * )
   28: *       COMPLEX*16         A( LDA, * )
   29: *       ..
   30: *  
   31: *
   32: *> \par Purpose:
   33: *  =============
   34: *>
   35: *> \verbatim
   36: *>
   37: *> ZGETC2 computes an LU factorization, using complete pivoting, of the
   38: *> n-by-n matrix A. The factorization has the form A = P * L * U * Q,
   39: *> where P and Q are permutation matrices, L is lower triangular with
   40: *> unit diagonal elements and U is upper triangular.
   41: *>
   42: *> This is a level 1 BLAS version of the algorithm.
   43: *> \endverbatim
   44: *
   45: *  Arguments:
   46: *  ==========
   47: *
   48: *> \param[in] N
   49: *> \verbatim
   50: *>          N is INTEGER
   51: *>          The order of the matrix A. N >= 0.
   52: *> \endverbatim
   53: *>
   54: *> \param[in,out] A
   55: *> \verbatim
   56: *>          A is COMPLEX*16 array, dimension (LDA, N)
   57: *>          On entry, the n-by-n matrix to be factored.
   58: *>          On exit, the factors L and U from the factorization
   59: *>          A = P*L*U*Q; the unit diagonal elements of L are not stored.
   60: *>          If U(k, k) appears to be less than SMIN, U(k, k) is given the
   61: *>          value of SMIN, giving a nonsingular perturbed system.
   62: *> \endverbatim
   63: *>
   64: *> \param[in] LDA
   65: *> \verbatim
   66: *>          LDA is INTEGER
   67: *>          The leading dimension of the array A.  LDA >= max(1, N).
   68: *> \endverbatim
   69: *>
   70: *> \param[out] IPIV
   71: *> \verbatim
   72: *>          IPIV is INTEGER array, dimension (N).
   73: *>          The pivot indices; for 1 <= i <= N, row i of the
   74: *>          matrix has been interchanged with row IPIV(i).
   75: *> \endverbatim
   76: *>
   77: *> \param[out] JPIV
   78: *> \verbatim
   79: *>          JPIV is INTEGER array, dimension (N).
   80: *>          The pivot indices; for 1 <= j <= N, column j of the
   81: *>          matrix has been interchanged with column JPIV(j).
   82: *> \endverbatim
   83: *>
   84: *> \param[out] INFO
   85: *> \verbatim
   86: *>          INFO is INTEGER
   87: *>           = 0: successful exit
   88: *>           > 0: if INFO = k, U(k, k) is likely to produce overflow if
   89: *>                one tries to solve for x in Ax = b. So U is perturbed
   90: *>                to avoid the overflow.
   91: *> \endverbatim
   92: *
   93: *  Authors:
   94: *  ========
   95: *
   96: *> \author Univ. of Tennessee 
   97: *> \author Univ. of California Berkeley 
   98: *> \author Univ. of Colorado Denver 
   99: *> \author NAG Ltd. 
  100: *
  101: *> \date September 2012
  102: *
  103: *> \ingroup complex16GEauxiliary
  104: *
  105: *> \par Contributors:
  106: *  ==================
  107: *>
  108: *>     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
  109: *>     Umea University, S-901 87 Umea, Sweden.
  110: *
  111: *  =====================================================================
  112:       SUBROUTINE ZGETC2( N, A, LDA, IPIV, JPIV, INFO )
  113: *
  114: *  -- LAPACK auxiliary routine (version 3.4.2) --
  115: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  116: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  117: *     September 2012
  118: *
  119: *     .. Scalar Arguments ..
  120:       INTEGER            INFO, LDA, N
  121: *     ..
  122: *     .. Array Arguments ..
  123:       INTEGER            IPIV( * ), JPIV( * )
  124:       COMPLEX*16         A( LDA, * )
  125: *     ..
  126: *
  127: *  =====================================================================
  128: *
  129: *     .. Parameters ..
  130:       DOUBLE PRECISION   ZERO, ONE
  131:       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
  132: *     ..
  133: *     .. Local Scalars ..
  134:       INTEGER            I, IP, IPV, J, JP, JPV
  135:       DOUBLE PRECISION   BIGNUM, EPS, SMIN, SMLNUM, XMAX
  136: *     ..
  137: *     .. External Subroutines ..
  138:       EXTERNAL           ZGERU, ZSWAP
  139: *     ..
  140: *     .. External Functions ..
  141:       DOUBLE PRECISION   DLAMCH
  142:       EXTERNAL           DLAMCH
  143: *     ..
  144: *     .. Intrinsic Functions ..
  145:       INTRINSIC          ABS, DCMPLX, MAX
  146: *     ..
  147: *     .. Executable Statements ..
  148: *
  149: *     Set constants to control overflow
  150: *
  151:       INFO = 0
  152:       EPS = DLAMCH( 'P' )
  153:       SMLNUM = DLAMCH( 'S' ) / EPS
  154:       BIGNUM = ONE / SMLNUM
  155:       CALL DLABAD( SMLNUM, BIGNUM )
  156: *
  157: *     Factorize A using complete pivoting.
  158: *     Set pivots less than SMIN to SMIN
  159: *
  160:       DO 40 I = 1, N - 1
  161: *
  162: *        Find max element in matrix A
  163: *
  164:          XMAX = ZERO
  165:          DO 20 IP = I, N
  166:             DO 10 JP = I, N
  167:                IF( ABS( A( IP, JP ) ).GE.XMAX ) THEN
  168:                   XMAX = ABS( A( IP, JP ) )
  169:                   IPV = IP
  170:                   JPV = JP
  171:                END IF
  172:    10       CONTINUE
  173:    20    CONTINUE
  174:          IF( I.EQ.1 )
  175:      $      SMIN = MAX( EPS*XMAX, SMLNUM )
  176: *
  177: *        Swap rows
  178: *
  179:          IF( IPV.NE.I )
  180:      $      CALL ZSWAP( N, A( IPV, 1 ), LDA, A( I, 1 ), LDA )
  181:          IPIV( I ) = IPV
  182: *
  183: *        Swap columns
  184: *
  185:          IF( JPV.NE.I )
  186:      $      CALL ZSWAP( N, A( 1, JPV ), 1, A( 1, I ), 1 )
  187:          JPIV( I ) = JPV
  188: *
  189: *        Check for singularity
  190: *
  191:          IF( ABS( A( I, I ) ).LT.SMIN ) THEN
  192:             INFO = I
  193:             A( I, I ) = DCMPLX( SMIN, ZERO )
  194:          END IF
  195:          DO 30 J = I + 1, N
  196:             A( J, I ) = A( J, I ) / A( I, I )
  197:    30    CONTINUE
  198:          CALL ZGERU( N-I, N-I, -DCMPLX( ONE ), A( I+1, I ), 1,
  199:      $               A( I, I+1 ), LDA, A( I+1, I+1 ), LDA )
  200:    40 CONTINUE
  201: *
  202:       IF( ABS( A( N, N ) ).LT.SMIN ) THEN
  203:          INFO = N
  204:          A( N, N ) = DCMPLX( SMIN, ZERO )
  205:       END IF
  206:       RETURN
  207: *
  208: *     End of ZGETC2
  209: *
  210:       END

CVSweb interface <joel.bertrand@systella.fr>