![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 C> \brief \b SGETRF VARIANT: left-looking Level 3 BLAS version of the algorithm. 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE SGETRF ( M, N, A, LDA, IPIV, INFO) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER INFO, LDA, M, N 00015 * .. 00016 * .. Array Arguments .. 00017 * INTEGER IPIV( * ) 00018 * REAL A( LDA, * ) 00019 * .. 00020 * 00021 * Purpose 00022 * ======= 00023 * 00024 C>\details \b Purpose: 00025 C>\verbatim 00026 C> 00027 C> SGETRF computes an LU factorization of a general M-by-N matrix A 00028 C> using partial pivoting with row interchanges. 00029 C> 00030 C> The factorization has the form 00031 C> A = P * L * U 00032 C> where P is a permutation matrix, L is lower triangular with unit 00033 C> diagonal elements (lower trapezoidal if m > n), and U is upper 00034 C> triangular (upper trapezoidal if m < n). 00035 C> 00036 C> This is the left-looking Level 3 BLAS version of the algorithm. 00037 C> 00038 C>\endverbatim 00039 * 00040 * Arguments: 00041 * ========== 00042 * 00043 C> \param[in] M 00044 C> \verbatim 00045 C> M is INTEGER 00046 C> The number of rows of the matrix A. M >= 0. 00047 C> \endverbatim 00048 C> 00049 C> \param[in] N 00050 C> \verbatim 00051 C> N is INTEGER 00052 C> The number of columns of the matrix A. N >= 0. 00053 C> \endverbatim 00054 C> 00055 C> \param[in,out] A 00056 C> \verbatim 00057 C> A is REAL array, dimension (LDA,N) 00058 C> On entry, the M-by-N matrix to be factored. 00059 C> On exit, the factors L and U from the factorization 00060 C> A = P*L*U; the unit diagonal elements of L are not stored. 00061 C> \endverbatim 00062 C> 00063 C> \param[in] LDA 00064 C> \verbatim 00065 C> LDA is INTEGER 00066 C> The leading dimension of the array A. LDA >= max(1,M). 00067 C> \endverbatim 00068 C> 00069 C> \param[out] IPIV 00070 C> \verbatim 00071 C> IPIV is INTEGER array, dimension (min(M,N)) 00072 C> The pivot indices; for 1 <= i <= min(M,N), row i of the 00073 C> matrix was interchanged with row IPIV(i). 00074 C> \endverbatim 00075 C> 00076 C> \param[out] INFO 00077 C> \verbatim 00078 C> INFO is INTEGER 00079 C> = 0: successful exit 00080 C> < 0: if INFO = -i, the i-th argument had an illegal value 00081 C> > 0: if INFO = i, U(i,i) is exactly zero. The factorization 00082 C> has been completed, but the factor U is exactly 00083 C> singular, and division by zero will occur if it is used 00084 C> to solve a system of equations. 00085 C> \endverbatim 00086 C> 00087 * 00088 * Authors: 00089 * ======== 00090 * 00091 C> \author Univ. of Tennessee 00092 C> \author Univ. of California Berkeley 00093 C> \author Univ. of Colorado Denver 00094 C> \author NAG Ltd. 00095 * 00096 C> \date November 2011 00097 * 00098 C> \ingroup variantsGEcomputational 00099 * 00100 * ===================================================================== 00101 SUBROUTINE SGETRF ( M, N, A, LDA, IPIV, INFO) 00102 * 00103 * -- LAPACK computational routine (version 3.1) -- 00104 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00105 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00106 * November 2011 00107 * 00108 * .. Scalar Arguments .. 00109 INTEGER INFO, LDA, M, N 00110 * .. 00111 * .. Array Arguments .. 00112 INTEGER IPIV( * ) 00113 REAL A( LDA, * ) 00114 * .. 00115 * 00116 * ===================================================================== 00117 * 00118 * .. Parameters .. 00119 REAL ONE 00120 PARAMETER ( ONE = 1.0E+0 ) 00121 * .. 00122 * .. Local Scalars .. 00123 INTEGER I, IINFO, J, JB, K, NB 00124 * .. 00125 * .. External Subroutines .. 00126 EXTERNAL SGEMM, SGETF2, SLASWP, STRSM, XERBLA 00127 * .. 00128 * .. External Functions .. 00129 INTEGER ILAENV 00130 EXTERNAL ILAENV 00131 * .. 00132 * .. Intrinsic Functions .. 00133 INTRINSIC MAX, MIN 00134 * .. 00135 * .. Executable Statements .. 00136 * 00137 * Test the input parameters. 00138 * 00139 INFO = 0 00140 IF( M.LT.0 ) THEN 00141 INFO = -1 00142 ELSE IF( N.LT.0 ) THEN 00143 INFO = -2 00144 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN 00145 INFO = -4 00146 END IF 00147 IF( INFO.NE.0 ) THEN 00148 CALL XERBLA( 'SGETRF', -INFO ) 00149 RETURN 00150 END IF 00151 * 00152 * Quick return if possible 00153 * 00154 IF( M.EQ.0 .OR. N.EQ.0 ) 00155 $ RETURN 00156 * 00157 * Determine the block size for this environment. 00158 * 00159 NB = ILAENV( 1, 'SGETRF', ' ', M, N, -1, -1 ) 00160 IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN 00161 * 00162 * Use unblocked code. 00163 * 00164 CALL SGETF2( M, N, A, LDA, IPIV, INFO ) 00165 00166 ELSE 00167 * 00168 * Use blocked code. 00169 * 00170 DO 20 J = 1, MIN( M, N ), NB 00171 JB = MIN( MIN( M, N )-J+1, NB ) 00172 * 00173 * 00174 * Update before factoring the current panel 00175 * 00176 DO 30 K = 1, J-NB, NB 00177 * 00178 * Apply interchanges to rows K:K+NB-1. 00179 * 00180 CALL SLASWP( JB, A(1, J), LDA, K, K+NB-1, IPIV, 1 ) 00181 * 00182 * Compute block row of U. 00183 * 00184 CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit', 00185 $ NB, JB, ONE, A( K, K ), LDA, 00186 $ A( K, J ), LDA ) 00187 * 00188 * Update trailing submatrix. 00189 * 00190 CALL SGEMM( 'No transpose', 'No transpose', 00191 $ M-K-NB+1, JB, NB, -ONE, 00192 $ A( K+NB, K ), LDA, A( K, J ), LDA, ONE, 00193 $ A( K+NB, J ), LDA ) 00194 30 CONTINUE 00195 * 00196 * Factor diagonal and subdiagonal blocks and test for exact 00197 * singularity. 00198 * 00199 CALL SGETF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO ) 00200 * 00201 * Adjust INFO and the pivot indices. 00202 * 00203 IF( INFO.EQ.0 .AND. IINFO.GT.0 ) 00204 $ INFO = IINFO + J - 1 00205 DO 10 I = J, MIN( M, J+JB-1 ) 00206 IPIV( I ) = J - 1 + IPIV( I ) 00207 10 CONTINUE 00208 * 00209 20 CONTINUE 00210 00211 * 00212 * Apply interchanges to the left-overs 00213 * 00214 DO 40 K = 1, MIN( M, N ), NB 00215 CALL SLASWP( K-1, A( 1, 1 ), LDA, K, 00216 $ MIN (K+NB-1, MIN ( M, N )), IPIV, 1 ) 00217 40 CONTINUE 00218 * 00219 * Apply update to the M+1:N columns when N > M 00220 * 00221 IF ( N.GT.M ) THEN 00222 00223 CALL SLASWP( N-M, A(1, M+1), LDA, 1, M, IPIV, 1 ) 00224 00225 DO 50 K = 1, M, NB 00226 00227 JB = MIN( M-K+1, NB ) 00228 * 00229 CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit', 00230 $ JB, N-M, ONE, A( K, K ), LDA, 00231 $ A( K, M+1 ), LDA ) 00232 00233 * 00234 IF ( K+NB.LE.M ) THEN 00235 CALL SGEMM( 'No transpose', 'No transpose', 00236 $ M-K-NB+1, N-M, NB, -ONE, 00237 $ A( K+NB, K ), LDA, A( K, M+1 ), LDA, ONE, 00238 $ A( K+NB, M+1 ), LDA ) 00239 END IF 00240 50 CONTINUE 00241 END IF 00242 * 00243 END IF 00244 RETURN 00245 * 00246 * End of SGETRF 00247 * 00248 END