```001:       SUBROUTINE ZGETRF( M, N, A, LDA, IPIV, INFO )
002: *
003: *  -- LAPACK routine (version 3.2) --
004: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
005: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
006: *     November 2006
007: *
008: *     .. Scalar Arguments ..
009:       INTEGER            INFO, LDA, M, N
010: *     ..
011: *     .. Array Arguments ..
012:       INTEGER            IPIV( * )
013:       COMPLEX*16         A( LDA, * )
014: *     ..
015: *
016: *  Purpose
017: *  =======
018: *
019: *  ZGETRF computes an LU factorization of a general M-by-N matrix A
020: *  using partial pivoting with row interchanges.
021: *
022: *  The factorization has the form
023: *     A = P * L * U
024: *  where P is a permutation matrix, L is lower triangular with unit
025: *  diagonal elements (lower trapezoidal if m > n), and U is upper
026: *  triangular (upper trapezoidal if m < n).
027: *
028: *  This is the right-looking Level 3 BLAS version of the algorithm.
029: *
030: *  Arguments
031: *  =========
032: *
033: *  M       (input) INTEGER
034: *          The number of rows of the matrix A.  M >= 0.
035: *
036: *  N       (input) INTEGER
037: *          The number of columns of the matrix A.  N >= 0.
038: *
039: *  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
040: *          On entry, the M-by-N matrix to be factored.
041: *          On exit, the factors L and U from the factorization
042: *          A = P*L*U; the unit diagonal elements of L are not stored.
043: *
044: *  LDA     (input) INTEGER
045: *          The leading dimension of the array A.  LDA >= max(1,M).
046: *
047: *  IPIV    (output) INTEGER array, dimension (min(M,N))
048: *          The pivot indices; for 1 <= i <= min(M,N), row i of the
049: *          matrix was interchanged with row IPIV(i).
050: *
051: *  INFO    (output) INTEGER
052: *          = 0:  successful exit
053: *          < 0:  if INFO = -i, the i-th argument had an illegal value
054: *          > 0:  if INFO = i, U(i,i) is exactly zero. The factorization
055: *                has been completed, but the factor U is exactly
056: *                singular, and division by zero will occur if it is used
057: *                to solve a system of equations.
058: *
059: *  =====================================================================
060: *
061: *     .. Parameters ..
062:       COMPLEX*16         ONE
063:       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
064: *     ..
065: *     .. Local Scalars ..
066:       INTEGER            I, IINFO, J, JB, NB
067: *     ..
068: *     .. External Subroutines ..
069:       EXTERNAL           XERBLA, ZGEMM, ZGETF2, ZLASWP, ZTRSM
070: *     ..
071: *     .. External Functions ..
072:       INTEGER            ILAENV
073:       EXTERNAL           ILAENV
074: *     ..
075: *     .. Intrinsic Functions ..
076:       INTRINSIC          MAX, MIN
077: *     ..
078: *     .. Executable Statements ..
079: *
080: *     Test the input parameters.
081: *
082:       INFO = 0
083:       IF( M.LT.0 ) THEN
084:          INFO = -1
085:       ELSE IF( N.LT.0 ) THEN
086:          INFO = -2
087:       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
088:          INFO = -4
089:       END IF
090:       IF( INFO.NE.0 ) THEN
091:          CALL XERBLA( 'ZGETRF', -INFO )
092:          RETURN
093:       END IF
094: *
095: *     Quick return if possible
096: *
097:       IF( M.EQ.0 .OR. N.EQ.0 )
098:      \$   RETURN
099: *
100: *     Determine the block size for this environment.
101: *
102:       NB = ILAENV( 1, 'ZGETRF', ' ', M, N, -1, -1 )
103:       IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN
104: *
105: *        Use unblocked code.
106: *
107:          CALL ZGETF2( M, N, A, LDA, IPIV, INFO )
108:       ELSE
109: *
110: *        Use blocked code.
111: *
112:          DO 20 J = 1, MIN( M, N ), NB
113:             JB = MIN( MIN( M, N )-J+1, NB )
114: *
115: *           Factor diagonal and subdiagonal blocks and test for exact
116: *           singularity.
117: *
118:             CALL ZGETF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO )
119: *
120: *           Adjust INFO and the pivot indices.
121: *
122:             IF( INFO.EQ.0 .AND. IINFO.GT.0 )
123:      \$         INFO = IINFO + J - 1
124:             DO 10 I = J, MIN( M, J+JB-1 )
125:                IPIV( I ) = J - 1 + IPIV( I )
126:    10       CONTINUE
127: *
128: *           Apply interchanges to columns 1:J-1.
129: *
130:             CALL ZLASWP( J-1, A, LDA, J, J+JB-1, IPIV, 1 )
131: *
132:             IF( J+JB.LE.N ) THEN
133: *
134: *              Apply interchanges to columns J+JB:N.
135: *
136:                CALL ZLASWP( N-J-JB+1, A( 1, J+JB ), LDA, J, J+JB-1,
137:      \$                      IPIV, 1 )
138: *
139: *              Compute block row of U.
140: *
141:                CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB,
142:      \$                     N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ),
143:      \$                     LDA )
144:                IF( J+JB.LE.M ) THEN
145: *
146: *                 Update trailing submatrix.
147: *
148:                   CALL ZGEMM( 'No transpose', 'No transpose', M-J-JB+1,
149:      \$                        N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA,
150:      \$                        A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ),
151:      \$                        LDA )
152:                END IF
153:             END IF
154:    20    CONTINUE
155:       END IF
156:       RETURN
157: *
158: *     End of ZGETRF
159: *
160:       END
161: ```