1C> \brief \b ZGETRF VARIANT: left-looking Level 3 BLAS version of the algorithm.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE ZGETRF ( 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*16         A( LDA, * )
19*       ..
20*
21*  Purpose
22*  =======
23*
24C>\details \b Purpose:
25C>\verbatim
26C>
27C> ZGETRF computes an LU factorization of a general M-by-N matrix A
28C> using partial pivoting with row interchanges.
29C>
30C> The factorization has the form
31C>    A = P * L * U
32C> where P is a permutation matrix, L is lower triangular with unit
33C> diagonal elements (lower trapezoidal if m > n), and U is upper
34C> triangular (upper trapezoidal if m < n).
35C>
36C> This is the left-looking Level 3 BLAS version of the algorithm.
37C>
38C>\endverbatim
39*
40*  Arguments:
41*  ==========
42*
43C> \param[in] M
44C> \verbatim
45C>          M is INTEGER
46C>          The number of rows of the matrix A.  M >= 0.
47C> \endverbatim
48C>
49C> \param[in] N
50C> \verbatim
51C>          N is INTEGER
52C>          The number of columns of the matrix A.  N >= 0.
53C> \endverbatim
54C>
55C> \param[in,out] A
56C> \verbatim
57C>          A is COMPLEX*16 array, dimension (LDA,N)
58C>          On entry, the M-by-N matrix to be factored.
59C>          On exit, the factors L and U from the factorization
60C>          A = P*L*U; the unit diagonal elements of L are not stored.
61C> \endverbatim
62C>
63C> \param[in] LDA
64C> \verbatim
65C>          LDA is INTEGER
66C>          The leading dimension of the array A.  LDA >= max(1,M).
67C> \endverbatim
68C>
69C> \param[out] IPIV
70C> \verbatim
71C>          IPIV is INTEGER array, dimension (min(M,N))
72C>          The pivot indices; for 1 <= i <= min(M,N), row i of the
73C>          matrix was interchanged with row IPIV(i).
74C> \endverbatim
75C>
76C> \param[out] INFO
77C> \verbatim
78C>          INFO is INTEGER
79C>          = 0:  successful exit
80C>          < 0:  if INFO = -i, the i-th argument had an illegal value
81C>          > 0:  if INFO = i, U(i,i) is exactly zero. The factorization
82C>                has been completed, but the factor U is exactly
83C>                singular, and division by zero will occur if it is used
84C>                to solve a system of equations.
85C> \endverbatim
86C>
87*
88*  Authors:
89*  ========
90*
91C> \author Univ. of Tennessee
92C> \author Univ. of California Berkeley
93C> \author Univ. of Colorado Denver
94C> \author NAG Ltd.
95*
96C> \date November 2011
97*
98C> \ingroup variantsGEcomputational
99*
100*  =====================================================================
101      SUBROUTINE ZGETRF ( M, N, A, LDA, IPIV, INFO)
102*
103*  -- LAPACK computational routine (version 3.1) --
104*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
105*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
106*     November 2011
107*
108*     .. Scalar Arguments ..
109      INTEGER            INFO, LDA, M, N
110*     ..
111*     .. Array Arguments ..
112      INTEGER            IPIV( * )
113      COMPLEX*16         A( LDA, * )
114*     ..
115*
116*  =====================================================================
117*
118*     .. Parameters ..
119      COMPLEX*16         ONE
120      PARAMETER          ( ONE = (1.0D+0, 0.0D+0) )
121*     ..
122*     .. Local Scalars ..
123      INTEGER            I, IINFO, J, JB, K, NB
124*     ..
125*     .. External Subroutines ..
126      EXTERNAL           ZGEMM, ZGETF2, ZLASWP, ZTRSM, XERBLA
127*     ..
128*     .. External Functions ..
129      INTEGER            ILAENV
130      EXTERNAL           ILAENV
131*     ..
132*     .. Intrinsic Functions ..
133      INTRINSIC          MAX, MIN
134*     ..
135*     .. Executable Statements ..
136*
137*     Test the input parameters.
138*
139      INFO = 0
140      IF( M.LT.0 ) THEN
141         INFO = -1
142      ELSE IF( N.LT.0 ) THEN
143         INFO = -2
144      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
145         INFO = -4
146      END IF
147      IF( INFO.NE.0 ) THEN
148         CALL XERBLA( 'ZGETRF', -INFO )
149         RETURN
150      END IF
151*
152*     Quick return if possible
153*
154      IF( M.EQ.0 .OR. N.EQ.0 )
155     $   RETURN
156*
157*     Determine the block size for this environment.
158*
159      NB = ILAENV( 1, 'ZGETRF', ' ', M, N, -1, -1 )
160      IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN
161*
162*        Use unblocked code.
163*
164         CALL ZGETF2( M, N, A, LDA, IPIV, INFO )
165
166      ELSE
167*
168*        Use blocked code.
169*
170         DO 20 J = 1, MIN( M, N ), NB
171            JB = MIN( MIN( M, N )-J+1, NB )
172*
173*
174*           Update before factoring the current panel
175*
176            DO 30 K = 1, J-NB, NB
177*
178*              Apply interchanges to rows K:K+NB-1.
179*
180               CALL ZLASWP( JB, A(1, J), LDA, K, K+NB-1, IPIV, 1 )
181*
182*              Compute block row of U.
183*
184               CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit',
185     $                    NB, JB, ONE, A( K, K ), LDA,
186     $                    A( K, J ), LDA )
187*
188*              Update trailing submatrix.
189*
190               CALL ZGEMM( 'No transpose', 'No transpose',
191     $                    M-K-NB+1, JB, NB, -ONE,
192     $                    A( K+NB, K ), LDA, A( K, J ), LDA, ONE,
193     $                    A( K+NB, J ), LDA )
194   30       CONTINUE
195*
196*           Factor diagonal and subdiagonal blocks and test for exact
197*           singularity.
198*
199            CALL ZGETF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO )
200*
201*           Adjust INFO and the pivot indices.
202*
203            IF( INFO.EQ.0 .AND. IINFO.GT.0 )
204     $         INFO = IINFO + J - 1
205            DO 10 I = J, MIN( M, J+JB-1 )
206               IPIV( I ) = J - 1 + IPIV( I )
207   10       CONTINUE
208*
209   20    CONTINUE
210
211*
212*        Apply interchanges to the left-overs
213*
214         DO 40 K = 1, MIN( M, N ), NB
215            CALL ZLASWP( K-1, A( 1, 1 ), LDA, K,
216     $                  MIN (K+NB-1, MIN ( M, N )), IPIV, 1 )
217   40    CONTINUE
218*
219*        Apply update to the M+1:N columns when N > M
220*
221         IF ( N.GT.M ) THEN
222
223            CALL ZLASWP( N-M, A(1, M+1), LDA, 1, M, IPIV, 1 )
224
225            DO 50 K = 1, M, NB
226
227               JB = MIN( M-K+1, NB )
228*
229               CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit',
230     $                    JB, N-M, ONE, A( K, K ), LDA,
231     $                    A( K, M+1 ), LDA )
232
233*
234               IF ( K+NB.LE.M ) THEN
235                    CALL ZGEMM( 'No transpose', 'No transpose',
236     $                         M-K-NB+1, N-M, NB, -ONE,
237     $                         A( K+NB, K ), LDA, A( K, M+1 ), LDA, ONE,
238     $                        A( K+NB, M+1 ), LDA )
239               END IF
240   50       CONTINUE
241         END IF
242*
243      END IF
244      RETURN
245*
246*     End of ZGETRF
247*
248      END
249