1*> \brief \b ZGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row interchanges (unblocked algorithm).
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZGETF2 + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgetf2.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgetf2.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgetf2.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE ZGETF2( M, N, A, LDA, IPIV, INFO )
22*
23*       .. Scalar Arguments ..
24*       INTEGER            INFO, LDA, M, N
25*       ..
26*       .. Array Arguments ..
27*       INTEGER            IPIV( * )
28*       COMPLEX*16         A( LDA, * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> ZGETF2 computes an LU factorization of a general m-by-n matrix A
38*> using partial pivoting with row interchanges.
39*>
40*> The factorization has the form
41*>    A = P * L * U
42*> where P is a permutation matrix, L is lower triangular with unit
43*> diagonal elements (lower trapezoidal if m > n), and U is upper
44*> triangular (upper trapezoidal if m < n).
45*>
46*> This is the right-looking Level 2 BLAS version of the algorithm.
47*> \endverbatim
48*
49*  Arguments:
50*  ==========
51*
52*> \param[in] M
53*> \verbatim
54*>          M is INTEGER
55*>          The number of rows of the matrix A.  M >= 0.
56*> \endverbatim
57*>
58*> \param[in] N
59*> \verbatim
60*>          N is INTEGER
61*>          The number of columns of the matrix A.  N >= 0.
62*> \endverbatim
63*>
64*> \param[in,out] A
65*> \verbatim
66*>          A is COMPLEX*16 array, dimension (LDA,N)
67*>          On entry, the m by n matrix to be factored.
68*>          On exit, the factors L and U from the factorization
69*>          A = P*L*U; the unit diagonal elements of L are not stored.
70*> \endverbatim
71*>
72*> \param[in] LDA
73*> \verbatim
74*>          LDA is INTEGER
75*>          The leading dimension of the array A.  LDA >= max(1,M).
76*> \endverbatim
77*>
78*> \param[out] IPIV
79*> \verbatim
80*>          IPIV is INTEGER array, dimension (min(M,N))
81*>          The pivot indices; for 1 <= i <= min(M,N), row i of the
82*>          matrix was interchanged with row IPIV(i).
83*> \endverbatim
84*>
85*> \param[out] INFO
86*> \verbatim
87*>          INFO is INTEGER
88*>          = 0: successful exit
89*>          < 0: if INFO = -k, the k-th argument had an illegal value
90*>          > 0: if INFO = k, U(k,k) is exactly zero. The factorization
91*>               has been completed, but the factor U is exactly
92*>               singular, and division by zero will occur if it is used
93*>               to solve a system of equations.
94*> \endverbatim
95*
96*  Authors:
97*  ========
98*
99*> \author Univ. of Tennessee
100*> \author Univ. of California Berkeley
101*> \author Univ. of Colorado Denver
102*> \author NAG Ltd.
103*
104*> \date September 2012
105*
106*> \ingroup complex16GEcomputational
107*
108*  =====================================================================
109      SUBROUTINE ZGETF2( M, N, A, LDA, IPIV, INFO )
110*
111*  -- LAPACK computational routine (version 3.4.2) --
112*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
113*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
114*     September 2012
115*
116*     .. Scalar Arguments ..
117      INTEGER            INFO, LDA, M, N
118*     ..
119*     .. Array Arguments ..
120      INTEGER            IPIV( * )
121      COMPLEX*16         A( LDA, * )
122*     ..
123*
124*  =====================================================================
125*
126*     .. Parameters ..
127      COMPLEX*16         ONE, ZERO
128      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
129     $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
130*     ..
131*     .. Local Scalars ..
132      DOUBLE PRECISION   SFMIN
133      INTEGER            I, J, JP
134*     ..
135*     .. External Functions ..
136      DOUBLE PRECISION   DLAMCH
137      INTEGER            IZAMAX
138      EXTERNAL           DLAMCH, IZAMAX
139*     ..
140*     .. External Subroutines ..
141      EXTERNAL           XERBLA, ZGERU, ZSCAL, ZSWAP
142*     ..
143*     .. Intrinsic Functions ..
144      INTRINSIC          MAX, MIN
145*     ..
146*     .. Executable Statements ..
147*
148*     Test the input parameters.
149*
150      INFO = 0
151      IF( M.LT.0 ) THEN
152         INFO = -1
153      ELSE IF( N.LT.0 ) THEN
154         INFO = -2
155      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
156         INFO = -4
157      END IF
158      IF( INFO.NE.0 ) THEN
159         CALL XERBLA( 'ZGETF2', -INFO )
160         RETURN
161      END IF
162*
163*     Quick return if possible
164*
165      IF( M.EQ.0 .OR. N.EQ.0 )
166     $   RETURN
167*
168*     Compute machine safe minimum
169*
170      SFMIN = DLAMCH('S')
171*
172      DO 10 J = 1, MIN( M, N )
173*
174*        Find pivot and test for singularity.
175*
176         JP = J - 1 + IZAMAX( M-J+1, A( J, J ), 1 )
177         IPIV( J ) = JP
178         IF( A( JP, J ).NE.ZERO ) THEN
179*
180*           Apply the interchange to columns 1:N.
181*
182            IF( JP.NE.J )
183     $         CALL ZSWAP( N, A( J, 1 ), LDA, A( JP, 1 ), LDA )
184*
185*           Compute elements J+1:M of J-th column.
186*
187            IF( J.LT.M ) THEN
188               IF( ABS(A( J, J )) .GE. SFMIN ) THEN
189                  CALL ZSCAL( M-J, ONE / A( J, J ), A( J+1, J ), 1 )
190               ELSE
191                  DO 20 I = 1, M-J
192                     A( J+I, J ) = A( J+I, J ) / A( J, J )
193   20             CONTINUE
194               END IF
195            END IF
196*
197         ELSE IF( INFO.EQ.0 ) THEN
198*
199            INFO = J
200         END IF
201*
202         IF( J.LT.MIN( M, N ) ) THEN
203*
204*           Update trailing submatrix.
205*
206            CALL ZGERU( M-J, N-J, -ONE, A( J+1, J ), 1, A( J, J+1 ),
207     $                  LDA, A( J+1, J+1 ), LDA )
208         END IF
209   10 CONTINUE
210      RETURN
211*
212*     End of ZGETF2
213*
214      END
215