![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZGETC2 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download ZGETC2 + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgetc2.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgetc2.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgetc2.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE ZGETC2( N, A, LDA, IPIV, JPIV, INFO ) 00022 * 00023 * .. Scalar Arguments .. 00024 * INTEGER INFO, LDA, N 00025 * .. 00026 * .. Array Arguments .. 00027 * INTEGER IPIV( * ), JPIV( * ) 00028 * COMPLEX*16 A( LDA, * ) 00029 * .. 00030 * 00031 * 00032 *> \par Purpose: 00033 * ============= 00034 *> 00035 *> \verbatim 00036 *> 00037 *> ZGETC2 computes an LU factorization, using complete pivoting, of the 00038 *> n-by-n matrix A. The factorization has the form A = P * L * U * Q, 00039 *> where P and Q are permutation matrices, L is lower triangular with 00040 *> unit diagonal elements and U is upper triangular. 00041 *> 00042 *> This is a level 1 BLAS version of the algorithm. 00043 *> \endverbatim 00044 * 00045 * Arguments: 00046 * ========== 00047 * 00048 *> \param[in] N 00049 *> \verbatim 00050 *> N is INTEGER 00051 *> The order of the matrix A. N >= 0. 00052 *> \endverbatim 00053 *> 00054 *> \param[in,out] A 00055 *> \verbatim 00056 *> A is COMPLEX*16 array, dimension (LDA, N) 00057 *> On entry, the n-by-n matrix to be factored. 00058 *> On exit, the factors L and U from the factorization 00059 *> A = P*L*U*Q; the unit diagonal elements of L are not stored. 00060 *> If U(k, k) appears to be less than SMIN, U(k, k) is given the 00061 *> value of SMIN, giving a nonsingular perturbed system. 00062 *> \endverbatim 00063 *> 00064 *> \param[in] LDA 00065 *> \verbatim 00066 *> LDA is INTEGER 00067 *> The leading dimension of the array A. LDA >= max(1, N). 00068 *> \endverbatim 00069 *> 00070 *> \param[out] IPIV 00071 *> \verbatim 00072 *> IPIV is INTEGER array, dimension (N). 00073 *> The pivot indices; for 1 <= i <= N, row i of the 00074 *> matrix has been interchanged with row IPIV(i). 00075 *> \endverbatim 00076 *> 00077 *> \param[out] JPIV 00078 *> \verbatim 00079 *> JPIV is INTEGER array, dimension (N). 00080 *> The pivot indices; for 1 <= j <= N, column j of the 00081 *> matrix has been interchanged with column JPIV(j). 00082 *> \endverbatim 00083 *> 00084 *> \param[out] INFO 00085 *> \verbatim 00086 *> INFO is INTEGER 00087 *> = 0: successful exit 00088 *> > 0: if INFO = k, U(k, k) is likely to produce overflow if 00089 *> one tries to solve for x in Ax = b. So U is perturbed 00090 *> to avoid the overflow. 00091 *> \endverbatim 00092 * 00093 * Authors: 00094 * ======== 00095 * 00096 *> \author Univ. of Tennessee 00097 *> \author Univ. of California Berkeley 00098 *> \author Univ. of Colorado Denver 00099 *> \author NAG Ltd. 00100 * 00101 *> \date November 2011 00102 * 00103 *> \ingroup complex16GEauxiliary 00104 * 00105 *> \par Contributors: 00106 * ================== 00107 *> 00108 *> Bo Kagstrom and Peter Poromaa, Department of Computing Science, 00109 *> Umea University, S-901 87 Umea, Sweden. 00110 * 00111 * ===================================================================== 00112 SUBROUTINE ZGETC2( N, A, LDA, IPIV, JPIV, INFO ) 00113 * 00114 * -- LAPACK auxiliary routine (version 3.4.0) -- 00115 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00116 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00117 * November 2011 00118 * 00119 * .. Scalar Arguments .. 00120 INTEGER INFO, LDA, N 00121 * .. 00122 * .. Array Arguments .. 00123 INTEGER IPIV( * ), JPIV( * ) 00124 COMPLEX*16 A( LDA, * ) 00125 * .. 00126 * 00127 * ===================================================================== 00128 * 00129 * .. Parameters .. 00130 DOUBLE PRECISION ZERO, ONE 00131 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) 00132 * .. 00133 * .. Local Scalars .. 00134 INTEGER I, IP, IPV, J, JP, JPV 00135 DOUBLE PRECISION BIGNUM, EPS, SMIN, SMLNUM, XMAX 00136 * .. 00137 * .. External Subroutines .. 00138 EXTERNAL ZGERU, ZSWAP 00139 * .. 00140 * .. External Functions .. 00141 DOUBLE PRECISION DLAMCH 00142 EXTERNAL DLAMCH 00143 * .. 00144 * .. Intrinsic Functions .. 00145 INTRINSIC ABS, DCMPLX, MAX 00146 * .. 00147 * .. Executable Statements .. 00148 * 00149 * Set constants to control overflow 00150 * 00151 INFO = 0 00152 EPS = DLAMCH( 'P' ) 00153 SMLNUM = DLAMCH( 'S' ) / EPS 00154 BIGNUM = ONE / SMLNUM 00155 CALL DLABAD( SMLNUM, BIGNUM ) 00156 * 00157 * Factorize A using complete pivoting. 00158 * Set pivots less than SMIN to SMIN 00159 * 00160 DO 40 I = 1, N - 1 00161 * 00162 * Find max element in matrix A 00163 * 00164 XMAX = ZERO 00165 DO 20 IP = I, N 00166 DO 10 JP = I, N 00167 IF( ABS( A( IP, JP ) ).GE.XMAX ) THEN 00168 XMAX = ABS( A( IP, JP ) ) 00169 IPV = IP 00170 JPV = JP 00171 END IF 00172 10 CONTINUE 00173 20 CONTINUE 00174 IF( I.EQ.1 ) 00175 $ SMIN = MAX( EPS*XMAX, SMLNUM ) 00176 * 00177 * Swap rows 00178 * 00179 IF( IPV.NE.I ) 00180 $ CALL ZSWAP( N, A( IPV, 1 ), LDA, A( I, 1 ), LDA ) 00181 IPIV( I ) = IPV 00182 * 00183 * Swap columns 00184 * 00185 IF( JPV.NE.I ) 00186 $ CALL ZSWAP( N, A( 1, JPV ), 1, A( 1, I ), 1 ) 00187 JPIV( I ) = JPV 00188 * 00189 * Check for singularity 00190 * 00191 IF( ABS( A( I, I ) ).LT.SMIN ) THEN 00192 INFO = I 00193 A( I, I ) = DCMPLX( SMIN, ZERO ) 00194 END IF 00195 DO 30 J = I + 1, N 00196 A( J, I ) = A( J, I ) / A( I, I ) 00197 30 CONTINUE 00198 CALL ZGERU( N-I, N-I, -DCMPLX( ONE ), A( I+1, I ), 1, 00199 $ A( I, I+1 ), LDA, A( I+1, I+1 ), LDA ) 00200 40 CONTINUE 00201 * 00202 IF( ABS( A( N, N ) ).LT.SMIN ) THEN 00203 INFO = N 00204 A( N, N ) = DCMPLX( SMIN, ZERO ) 00205 END IF 00206 RETURN 00207 * 00208 * End of ZGETC2 00209 * 00210 END