LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cgetrf2.f
Go to the documentation of this file.
1*> \brief \b CGETRF2
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 CGETRF2( M, N, A, LDA, IPIV, INFO )
12*
13* .. Scalar Arguments ..
14* INTEGER INFO, LDA, M, N
15* ..
16* .. Array Arguments ..
17* INTEGER IPIV( * )
18* COMPLEX A( LDA, * )
19* ..
20*
21*
22*> \par Purpose:
23* =============
24*>
25*> \verbatim
26*>
27*> CGETRF2 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 COMPLEX 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 getrf2
110*
111* =====================================================================
112 RECURSIVE SUBROUTINE cgetrf2( 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 COMPLEX a( lda, * )
124* ..
125*
126* =====================================================================
127*
128* .. Parameters ..
129 COMPLEX one, zero
130 parameter( one = ( 1.0e+0, 0.0e+0 ),
131 $ zero = ( 0.0e+0, 0.0e+0 ) )
132* ..
133* .. Local Scalars ..
134 REAL sfmin
135 COMPLEX temp
136 INTEGER i, iinfo, n1, n2
137* ..
138* .. External Functions ..
139 REAL slamch
140 INTEGER icamax
141 EXTERNAL slamch, icamax
142* ..
143* .. External Subroutines ..
144 EXTERNAL cgemm, cscal, claswp, ctrsm, xerbla
145* ..
146* .. Intrinsic Functions ..
147 INTRINSIC max, min
148* ..
149* .. Executable Statements ..
150*
151* Test the input parameters
152*
153 info = 0
154 IF( m.LT.0 ) THEN
155 info = -1
156 ELSE IF( n.LT.0 ) THEN
157 info = -2
158 ELSE IF( lda.LT.max( 1, m ) ) THEN
159 info = -4
160 END IF
161 IF( info.NE.0 ) THEN
162 CALL xerbla( 'CGETRF2', -info )
163 RETURN
164 END IF
165*
166* Quick return if possible
167*
168 IF( m.EQ.0 .OR. n.EQ.0 )
169 $ RETURN
170
171 IF ( m.EQ.1 ) THEN
172*
173* Use unblocked code for one row case
174* Just need to handle IPIV and INFO
175*
176 ipiv( 1 ) = 1
177 IF ( a(1,1).EQ.zero )
178 $ info = 1
179*
180 ELSE IF( n.EQ.1 ) THEN
181*
182* Use unblocked code for one column case
183*
184*
185* Compute machine safe minimum
186*
187 sfmin = slamch('S')
188*
189* Find pivot and test for singularity
190*
191 i = icamax( m, a( 1, 1 ), 1 )
192 ipiv( 1 ) = i
193 IF( a( i, 1 ).NE.zero ) THEN
194*
195* Apply the interchange
196*
197 IF( i.NE.1 ) THEN
198 temp = a( 1, 1 )
199 a( 1, 1 ) = a( i, 1 )
200 a( i, 1 ) = temp
201 END IF
202*
203* Compute elements 2:M of the column
204*
205 IF( abs(a( 1, 1 )) .GE. sfmin ) THEN
206 CALL cscal( m-1, one / a( 1, 1 ), a( 2, 1 ), 1 )
207 ELSE
208 DO 10 i = 1, m-1
209 a( 1+i, 1 ) = a( 1+i, 1 ) / a( 1, 1 )
210 10 CONTINUE
211 END IF
212*
213 ELSE
214 info = 1
215 END IF
216*
217 ELSE
218*
219* Use recursive code
220*
221 n1 = min( m, n ) / 2
222 n2 = n-n1
223*
224* [ A11 ]
225* Factor [ --- ]
226* [ A21 ]
227*
228 CALL cgetrf2( m, n1, a, lda, ipiv, iinfo )
229
230 IF ( info.EQ.0 .AND. iinfo.GT.0 )
231 $ info = iinfo
232*
233* [ A12 ]
234* Apply interchanges to [ --- ]
235* [ A22 ]
236*
237 CALL claswp( n2, a( 1, n1+1 ), lda, 1, n1, ipiv, 1 )
238*
239* Solve A12
240*
241 CALL ctrsm( 'L', 'L', 'N', 'U', n1, n2, one, a, lda,
242 $ a( 1, n1+1 ), lda )
243*
244* Update A22
245*
246 CALL cgemm( 'N', 'N', m-n1, n2, n1, -one, a( n1+1, 1 ), lda,
247 $ a( 1, n1+1 ), lda, one, a( n1+1, n1+1 ), lda )
248*
249* Factor A22
250*
251 CALL cgetrf2( m-n1, n2, a( n1+1, n1+1 ), lda, ipiv( n1+1 ),
252 $ iinfo )
253*
254* Adjust INFO and the pivot indices
255*
256 IF ( info.EQ.0 .AND. iinfo.GT.0 )
257 $ info = iinfo + n1
258 DO 20 i = n1+1, min( m, n )
259 ipiv( i ) = ipiv( i ) + n1
260 20 CONTINUE
261*
262* Apply interchanges to A21
263*
264 CALL claswp( n1, a( 1, 1 ), lda, n1+1, min( m, n), ipiv, 1 )
265*
266 END IF
267 RETURN
268*
269* End of CGETRF2
270*
271 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine cgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
CGEMM
Definition cgemm.f:188
recursive subroutine cgetrf2(m, n, a, lda, ipiv, info)
CGETRF2
Definition cgetrf2.f:113
integer function icamax(n, cx, incx)
ICAMAX
Definition icamax.f:71
real function slamch(cmach)
SLAMCH
Definition slamch.f:68
subroutine claswp(n, a, lda, k1, k2, ipiv, incx)
CLASWP performs a series of row interchanges on a general rectangular matrix.
Definition claswp.f:115
subroutine cscal(n, ca, cx, incx)
CSCAL
Definition cscal.f:78
subroutine ctrsm(side, uplo, transa, diag, m, n, alpha, a, lda, b, ldb)
CTRSM
Definition ctrsm.f:180