1*> \brief \b SGETRF2 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* RECURSIVE SUBROUTINE SGETRF2( M, N, A, LDA, IPIV, INFO ) 12* 13* .. Scalar Arguments .. 14* INTEGER INFO, LDA, M, N 15* .. 16* .. Array Arguments .. 17* INTEGER IPIV( * ) 18* REAL A( LDA, * ) 19* .. 20* 21* 22*> \par Purpose: 23* ============= 24*> 25*> \verbatim 26*> 27*> SGETRF2 computes an LU factorization of a general M-by-N matrix A 28*> using partial pivoting with row interchanges. 29*> 30*> The factorization has the form 31*> A = P * L * U 32*> where P is a permutation matrix, L is lower triangular with unit 33*> diagonal elements (lower trapezoidal if m > n), and U is upper 34*> triangular (upper trapezoidal if m < n). 35*> 36*> This is the recursive version of the algorithm. It divides 37*> the matrix into four submatrices: 38*> 39*> [ A11 | A12 ] where A11 is n1 by n1 and A22 is n2 by n2 40*> A = [ -----|----- ] with n1 = min(m,n)/2 41*> [ A21 | A22 ] n2 = n-n1 42*> 43*> [ A11 ] 44*> The subroutine calls itself to factor [ --- ], 45*> [ A12 ] 46*> [ A12 ] 47*> do the swaps on [ --- ], solve A12, update A22, 48*> [ A22 ] 49*> 50*> then calls itself to factor A22 and do the swaps on A21. 51*> 52*> \endverbatim 53* 54* Arguments: 55* ========== 56* 57*> \param[in] M 58*> \verbatim 59*> M is INTEGER 60*> The number of rows of the matrix A. M >= 0. 61*> \endverbatim 62*> 63*> \param[in] N 64*> \verbatim 65*> N is INTEGER 66*> The number of columns of the matrix A. N >= 0. 67*> \endverbatim 68*> 69*> \param[in,out] A 70*> \verbatim 71*> A is REAL array, dimension (LDA,N) 72*> On entry, the M-by-N matrix to be factored. 73*> On exit, the factors L and U from the factorization 74*> A = P*L*U; the unit diagonal elements of L are not stored. 75*> \endverbatim 76*> 77*> \param[in] LDA 78*> \verbatim 79*> LDA is INTEGER 80*> The leading dimension of the array A. LDA >= max(1,M). 81*> \endverbatim 82*> 83*> \param[out] IPIV 84*> \verbatim 85*> IPIV is INTEGER array, dimension (min(M,N)) 86*> The pivot indices; for 1 <= i <= min(M,N), row i of the 87*> matrix was interchanged with row IPIV(i). 88*> \endverbatim 89*> 90*> \param[out] INFO 91*> \verbatim 92*> INFO is INTEGER 93*> = 0: successful exit 94*> < 0: if INFO = -i, the i-th argument had an illegal value 95*> > 0: if INFO = i, U(i,i) is exactly zero. The factorization 96*> has been completed, but the factor U is exactly 97*> singular, and division by zero will occur if it is used 98*> to solve a system of equations. 99*> \endverbatim 100* 101* Authors: 102* ======== 103* 104*> \author Univ. of Tennessee 105*> \author Univ. of California Berkeley 106*> \author Univ. of Colorado Denver 107*> \author NAG Ltd. 108* 109*> \ingroup realGEcomputational 110* 111* ===================================================================== 112 RECURSIVE SUBROUTINE SGETRF2( M, N, A, LDA, IPIV, INFO ) 113* 114* -- LAPACK computational routine -- 115* -- LAPACK is a software package provided by Univ. of Tennessee, -- 116* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 117* 118* .. Scalar Arguments .. 119 INTEGER INFO, LDA, M, N 120* .. 121* .. Array Arguments .. 122 INTEGER IPIV( * ) 123 REAL A( LDA, * ) 124* .. 125* 126* ===================================================================== 127* 128* .. Parameters .. 129 REAL ONE, ZERO 130 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 131* .. 132* .. Local Scalars .. 133 REAL SFMIN, TEMP 134 INTEGER I, IINFO, n1, n2 135* .. 136* .. External Functions .. 137 REAL SLAMCH 138 INTEGER ISAMAX 139 EXTERNAL SLAMCH, ISAMAX 140* .. 141* .. External Subroutines .. 142 EXTERNAL SGEMM, SSCAL, SLASWP, STRSM, XERBLA 143* .. 144* .. Intrinsic Functions .. 145 INTRINSIC MAX, MIN 146* .. 147* .. Executable Statements .. 148* 149* Test the input parameters 150* 151 INFO = 0 152 IF( M.LT.0 ) THEN 153 INFO = -1 154 ELSE IF( N.LT.0 ) THEN 155 INFO = -2 156 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN 157 INFO = -4 158 END IF 159 IF( INFO.NE.0 ) THEN 160 CALL XERBLA( 'SGETRF2', -INFO ) 161 RETURN 162 END IF 163* 164* Quick return if possible 165* 166 IF( M.EQ.0 .OR. N.EQ.0 ) 167 $ RETURN 168 169 IF ( M.EQ.1 ) THEN 170* 171* Use unblocked code for one row case 172* Just need to handle IPIV and INFO 173* 174 IPIV( 1 ) = 1 175 IF ( A(1,1).EQ.ZERO ) 176 $ INFO = 1 177* 178 ELSE IF( N.EQ.1 ) THEN 179* 180* Use unblocked code for one column case 181* 182* 183* Compute machine safe minimum 184* 185 SFMIN = SLAMCH('S') 186* 187* Find pivot and test for singularity 188* 189 I = ISAMAX( M, A( 1, 1 ), 1 ) 190 IPIV( 1 ) = I 191 IF( A( I, 1 ).NE.ZERO ) THEN 192* 193* Apply the interchange 194* 195 IF( I.NE.1 ) THEN 196 TEMP = A( 1, 1 ) 197 A( 1, 1 ) = A( I, 1 ) 198 A( I, 1 ) = TEMP 199 END IF 200* 201* Compute elements 2:M of the column 202* 203 IF( ABS(A( 1, 1 )) .GE. SFMIN ) THEN 204 CALL SSCAL( M-1, ONE / A( 1, 1 ), A( 2, 1 ), 1 ) 205 ELSE 206 DO 10 I = 1, M-1 207 A( 1+I, 1 ) = A( 1+I, 1 ) / A( 1, 1 ) 208 10 CONTINUE 209 END IF 210* 211 ELSE 212 INFO = 1 213 END IF 214* 215 ELSE 216* 217* Use recursive code 218* 219 N1 = MIN( M, N ) / 2 220 N2 = N-N1 221* 222* [ A11 ] 223* Factor [ --- ] 224* [ A21 ] 225* 226 CALL SGETRF2( m, n1, A, lda, ipiv, iinfo ) 227 228 IF ( info.EQ.0 .AND. iinfo.GT.0 ) 229 $ info = iinfo 230* 231* [ A12 ] 232* Apply interchanges to [ --- ] 233* [ A22 ] 234* 235 CALL SLASWP( N2, A( 1, N1+1 ), LDA, 1, N1, IPIV, 1 ) 236* 237* Solve A12 238* 239 CALL STRSM( 'L', 'L', 'N', 'U', N1, N2, ONE, A, LDA, 240 $ A( 1, N1+1 ), LDA ) 241* 242* Update A22 243* 244 CALL SGEMM( 'N', 'N', M-N1, N2, N1, -ONE, A( N1+1, 1 ), LDA, 245 $ A( 1, N1+1 ), LDA, ONE, A( N1+1, N1+1 ), LDA ) 246* 247* Factor A22 248* 249 CALL SGETRF2( M-N1, N2, A( N1+1, N1+1 ), LDA, IPIV( N1+1 ), 250 $ IINFO ) 251* 252* Adjust INFO and the pivot indices 253* 254 IF ( INFO.EQ.0 .AND. IINFO.GT.0 ) 255 $ INFO = IINFO + N1 256 DO 20 I = N1+1, MIN( M, N ) 257 IPIV( I ) = IPIV( I ) + N1 258 20 CONTINUE 259* 260* Apply interchanges to A21 261* 262 CALL SLASWP( N1, A( 1, 1 ), LDA, N1+1, MIN( M, N), IPIV, 1 ) 263* 264 END IF 265 RETURN 266* 267* End of SGETRF2 268* 269 END 270