LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
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 *> \date September 2012
102 *
103 *> \ingroup complexGEauxiliary
104 *
105 *> \par Contributors:
106 * ==================
107 *>
108 *> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
109 *> Umea University, S-901 87 Umea, Sweden.
110 *
111 * =====================================================================
112  SUBROUTINE cgetc2( N, A, LDA, IPIV, JPIV, INFO )
113 *
114 * -- LAPACK auxiliary routine (version 3.4.2) --
115 * -- LAPACK is a software package provided by Univ. of Tennessee, --
116 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
117 * September 2012
118 *
119 * .. Scalar Arguments ..
120  INTEGER info, lda, n
121 * ..
122 * .. Array Arguments ..
123  INTEGER ipiv( * ), jpiv( * )
124  COMPLEX a( lda, * )
125 * ..
126 *
127 * =====================================================================
128 *
129 * .. Parameters ..
130  REAL zero, one
131  parameter( zero = 0.0e+0, one = 1.0e+0 )
132 * ..
133 * .. Local Scalars ..
134  INTEGER i, ip, ipv, j, jp, jpv
135  REAL bignum, eps, smin, smlnum, xmax
136 * ..
137 * .. External Subroutines ..
138  EXTERNAL cgeru, cswap, slabad
139 * ..
140 * .. External Functions ..
141  REAL slamch
142  EXTERNAL slamch
143 * ..
144 * .. Intrinsic Functions ..
145  INTRINSIC abs, cmplx, max
146 * ..
147 * .. Executable Statements ..
148 *
149 * Set constants to control overflow
150 *
151  info = 0
152  eps = slamch( 'P' )
153  smlnum = slamch( 'S' ) / eps
154  bignum = one / smlnum
155  CALL slabad( smlnum, bignum )
156 *
157 * Factorize A using complete pivoting.
158 * Set pivots less than SMIN to SMIN
159 *
160  DO 40 i = 1, n - 1
161 *
162 * Find max element in matrix A
163 *
164  xmax = zero
165  DO 20 ip = i, n
166  DO 10 jp = i, n
167  IF( abs( a( ip, jp ) ).GE.xmax ) THEN
168  xmax = abs( a( ip, jp ) )
169  ipv = ip
170  jpv = jp
171  END IF
172  10 continue
173  20 continue
174  IF( i.EQ.1 )
175  $ smin = max( eps*xmax, smlnum )
176 *
177 * Swap rows
178 *
179  IF( ipv.NE.i )
180  $ CALL cswap( n, a( ipv, 1 ), lda, a( i, 1 ), lda )
181  ipiv( i ) = ipv
182 *
183 * Swap columns
184 *
185  IF( jpv.NE.i )
186  $ CALL cswap( n, a( 1, jpv ), 1, a( 1, i ), 1 )
187  jpiv( i ) = jpv
188 *
189 * Check for singularity
190 *
191  IF( abs( a( i, i ) ).LT.smin ) THEN
192  info = i
193  a( i, i ) = cmplx( smin, zero )
194  END IF
195  DO 30 j = i + 1, n
196  a( j, i ) = a( j, i ) / a( i, i )
197  30 continue
198  CALL cgeru( n-i, n-i, -cmplx( one ), a( i+1, i ), 1,
199  $ a( i, i+1 ), lda, a( i+1, i+1 ), lda )
200  40 continue
201 *
202  IF( abs( a( n, n ) ).LT.smin ) THEN
203  info = n
204  a( n, n ) = cmplx( smin, zero )
205  END IF
206  return
207 *
208 * End of CGETC2
209 *
210  END