LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cgetc2.f
Go to the documentation of this file.
1*> \brief \b CGETC2 computes the LU factorization with complete pivoting of the general n-by-n matrix.
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CGETC2 + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgetc2.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgetc2.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgetc2.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE CGETC2( N, A, LDA, IPIV, JPIV, INFO )
22*
23* .. Scalar Arguments ..
24* INTEGER INFO, LDA, N
25* ..
26* .. Array Arguments ..
27* INTEGER IPIV( * ), JPIV( * )
28* COMPLEX A( LDA, * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> CGETC2 computes an LU factorization, using complete pivoting, of the
38*> n-by-n matrix A. The factorization has the form A = P * L * U * Q,
39*> where P and Q are permutation matrices, L is lower triangular with
40*> unit diagonal elements and U is upper triangular.
41*>
42*> This is a level 1 BLAS version of the algorithm.
43*> \endverbatim
44*
45* Arguments:
46* ==========
47*
48*> \param[in] N
49*> \verbatim
50*> N is INTEGER
51*> The order of the matrix A. N >= 0.
52*> \endverbatim
53*>
54*> \param[in,out] A
55*> \verbatim
56*> A is COMPLEX array, dimension (LDA, N)
57*> On entry, the n-by-n matrix to be factored.
58*> On exit, the factors L and U from the factorization
59*> A = P*L*U*Q; the unit diagonal elements of L are not stored.
60*> If U(k, k) appears to be less than SMIN, U(k, k) is given the
61*> value of SMIN, giving a nonsingular perturbed system.
62*> \endverbatim
63*>
64*> \param[in] LDA
65*> \verbatim
66*> LDA is INTEGER
67*> The leading dimension of the array A. LDA >= max(1, N).
68*> \endverbatim
69*>
70*> \param[out] IPIV
71*> \verbatim
72*> IPIV is INTEGER array, dimension (N).
73*> The pivot indices; for 1 <= i <= N, row i of the
74*> matrix has been interchanged with row IPIV(i).
75*> \endverbatim
76*>
77*> \param[out] JPIV
78*> \verbatim
79*> JPIV is INTEGER array, dimension (N).
80*> The pivot indices; for 1 <= j <= N, column j of the
81*> matrix has been interchanged with column JPIV(j).
82*> \endverbatim
83*>
84*> \param[out] INFO
85*> \verbatim
86*> INFO is INTEGER
87*> = 0: successful exit
88*> > 0: if INFO = k, U(k, k) is likely to produce overflow if
89*> one tries to solve for x in Ax = b. So U is perturbed
90*> to avoid the overflow.
91*> \endverbatim
92*
93* Authors:
94* ========
95*
96*> \author Univ. of Tennessee
97*> \author Univ. of California Berkeley
98*> \author Univ. of Colorado Denver
99*> \author NAG Ltd.
100*
101*> \ingroup getc2
102*
103*> \par Contributors:
104* ==================
105*>
106*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
107*> Umea University, S-901 87 Umea, Sweden.
108*
109* =====================================================================
110 SUBROUTINE cgetc2( N, A, LDA, IPIV, JPIV, INFO )
111*
112* -- LAPACK auxiliary routine --
113* -- LAPACK is a software package provided by Univ. of Tennessee, --
114* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
115*
116* .. Scalar Arguments ..
117 INTEGER INFO, LDA, N
118* ..
119* .. Array Arguments ..
120 INTEGER IPIV( * ), JPIV( * )
121 COMPLEX A( LDA, * )
122* ..
123*
124* =====================================================================
125*
126* .. Parameters ..
127 REAL ZERO, ONE
128 parameter( zero = 0.0e+0, one = 1.0e+0 )
129* ..
130* .. Local Scalars ..
131 INTEGER I, IP, IPV, J, JP, JPV
132 REAL BIGNUM, EPS, SMIN, SMLNUM, XMAX
133* ..
134* .. External Subroutines ..
135 EXTERNAL cgeru, cswap
136* ..
137* .. External Functions ..
138 REAL SLAMCH
139 EXTERNAL slamch
140* ..
141* .. Intrinsic Functions ..
142 INTRINSIC abs, cmplx, max
143* ..
144* .. Executable Statements ..
145*
146 info = 0
147*
148* Quick return if possible
149*
150 IF( n.EQ.0 )
151 $ RETURN
152*
153* Set constants to control overflow
154*
155 eps = slamch( 'P' )
156 smlnum = slamch( 'S' ) / eps
157 bignum = one / smlnum
158*
159* Handle the case N=1 by itself
160*
161 IF( n.EQ.1 ) THEN
162 ipiv( 1 ) = 1
163 jpiv( 1 ) = 1
164 IF( abs( a( 1, 1 ) ).LT.smlnum ) THEN
165 info = 1
166 a( 1, 1 ) = cmplx( smlnum, zero )
167 END IF
168 RETURN
169 END IF
170*
171* Factorize A using complete pivoting.
172* Set pivots less than SMIN to SMIN
173*
174 DO 40 i = 1, n - 1
175*
176* Find max element in matrix A
177*
178 xmax = zero
179 DO 20 ip = i, n
180 DO 10 jp = i, n
181 IF( abs( a( ip, jp ) ).GE.xmax ) THEN
182 xmax = abs( a( ip, jp ) )
183 ipv = ip
184 jpv = jp
185 END IF
186 10 CONTINUE
187 20 CONTINUE
188 IF( i.EQ.1 )
189 $ smin = max( eps*xmax, smlnum )
190*
191* Swap rows
192*
193 IF( ipv.NE.i )
194 $ CALL cswap( n, a( ipv, 1 ), lda, a( i, 1 ), lda )
195 ipiv( i ) = ipv
196*
197* Swap columns
198*
199 IF( jpv.NE.i )
200 $ CALL cswap( n, a( 1, jpv ), 1, a( 1, i ), 1 )
201 jpiv( i ) = jpv
202*
203* Check for singularity
204*
205 IF( abs( a( i, i ) ).LT.smin ) THEN
206 info = i
207 a( i, i ) = cmplx( smin, zero )
208 END IF
209 DO 30 j = i + 1, n
210 a( j, i ) = a( j, i ) / a( i, i )
211 30 CONTINUE
212 CALL cgeru( n-i, n-i, -cmplx( one ), a( i+1, i ), 1,
213 $ a( i, i+1 ), lda, a( i+1, i+1 ), lda )
214 40 CONTINUE
215*
216 IF( abs( a( n, n ) ).LT.smin ) THEN
217 info = n
218 a( n, n ) = cmplx( smin, zero )
219 END IF
220*
221* Set last pivots to N
222*
223 ipiv( n ) = n
224 jpiv( n ) = n
225*
226 RETURN
227*
228* End of CGETC2
229*
230 END
subroutine cgeru(m, n, alpha, x, incx, y, incy, a, lda)
CGERU
Definition cgeru.f:130
subroutine cgetc2(n, a, lda, ipiv, jpiv, info)
CGETC2 computes the LU factorization with complete pivoting of the general n-by-n matrix.
Definition cgetc2.f:111
subroutine cswap(n, cx, incx, cy, incy)
CSWAP
Definition cswap.f:81