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