![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SGETC2 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download SGETC2 + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgetc2.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgetc2.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgetc2.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE SGETC2( N, A, LDA, IPIV, JPIV, INFO ) 00022 * 00023 * .. Scalar Arguments .. 00024 * INTEGER INFO, LDA, N 00025 * .. 00026 * .. Array Arguments .. 00027 * INTEGER IPIV( * ), JPIV( * ) 00028 * REAL A( LDA, * ) 00029 * .. 00030 * 00031 * 00032 *> \par Purpose: 00033 * ============= 00034 *> 00035 *> \verbatim 00036 *> 00037 *> SGETC2 computes an LU factorization with 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 the Level 2 BLAS 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 REAL array, dimension (LDA, N) 00057 *> On entry, the n-by-n matrix A 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, i.e., 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 owerflow if 00089 *> we try to solve for x in Ax = b. So U is perturbed to 00090 *> 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 realGEauxiliary 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 SGETC2( 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 REAL A( LDA, * ) 00125 * .. 00126 * 00127 * ===================================================================== 00128 * 00129 * .. Parameters .. 00130 REAL ZERO, ONE 00131 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) 00132 * .. 00133 * .. Local Scalars .. 00134 INTEGER I, IP, IPV, J, JP, JPV 00135 REAL BIGNUM, EPS, SMIN, SMLNUM, XMAX 00136 * .. 00137 * .. External Subroutines .. 00138 EXTERNAL SGER, SLABAD, SSWAP 00139 * .. 00140 * .. External Functions .. 00141 REAL SLAMCH 00142 EXTERNAL SLAMCH 00143 * .. 00144 * .. Intrinsic Functions .. 00145 INTRINSIC ABS, MAX 00146 * .. 00147 * .. Executable Statements .. 00148 * 00149 * Set constants to control overflow 00150 * 00151 INFO = 0 00152 EPS = SLAMCH( 'P' ) 00153 SMLNUM = SLAMCH( 'S' ) / EPS 00154 BIGNUM = ONE / SMLNUM 00155 CALL SLABAD( 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 SSWAP( 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 SSWAP( 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 ) = SMIN 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 SGER( N-I, N-I, -ONE, A( I+1, I ), 1, A( I, I+1 ), LDA, 00199 $ 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 ) = SMIN 00205 END IF 00206 * 00207 RETURN 00208 * 00209 * End of SGETC2 00210 * 00211 END