LAPACK 3.3.0
|
00001 SUBROUTINE CGETRF ( M, N, A, LDA, IPIV, INFO) 00002 * 00003 * -- LAPACK routine (version 3.1) -- 00004 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00005 * March 2008 00006 * 00007 * .. Scalar Arguments .. 00008 INTEGER INFO, LDA, M, N 00009 * .. 00010 * .. Array Arguments .. 00011 INTEGER IPIV( * ) 00012 COMPLEX A( LDA, * ) 00013 * .. 00014 * 00015 * Purpose 00016 * ======= 00017 * 00018 * CGETRF computes an LU factorization of a general M-by-N matrix A 00019 * using partial pivoting with row interchanges. 00020 * 00021 * The factorization has the form 00022 * A = P * L * U 00023 * where P is a permutation matrix, L is lower triangular with unit 00024 * diagonal elements (lower trapezoidal if m > n), and U is upper 00025 * triangular (upper trapezoidal if m < n). 00026 * 00027 * This is the Crout Level 3 BLAS version of the algorithm. 00028 * 00029 * Arguments 00030 * ========= 00031 * 00032 * M (input) INTEGER 00033 * The number of rows of the matrix A. M >= 0. 00034 * 00035 * N (input) INTEGER 00036 * The number of columns of the matrix A. N >= 0. 00037 * 00038 * A (input/output) COMPLEX array, dimension (LDA,N) 00039 * On entry, the M-by-N matrix to be factored. 00040 * On exit, the factors L and U from the factorization 00041 * A = P*L*U; the unit diagonal elements of L are not stored. 00042 * 00043 * LDA (input) INTEGER 00044 * The leading dimension of the array A. LDA >= max(1,M). 00045 * 00046 * IPIV (output) INTEGER array, dimension (min(M,N)) 00047 * The pivot indices; for 1 <= i <= min(M,N), row i of the 00048 * matrix was interchanged with row IPIV(i). 00049 * 00050 * INFO (output) INTEGER 00051 * = 0: successful exit 00052 * < 0: if INFO = -i, the i-th argument had an illegal value 00053 * > 0: if INFO = i, U(i,i) is exactly zero. The factorization 00054 * has been completed, but the factor U is exactly 00055 * singular, and division by zero will occur if it is used 00056 * to solve a system of equations. 00057 * 00058 * ===================================================================== 00059 * 00060 * .. Parameters .. 00061 COMPLEX ONE 00062 PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) 00063 * .. 00064 * .. Local Scalars .. 00065 INTEGER I, IINFO, J, JB, NB 00066 * .. 00067 * .. External Subroutines .. 00068 EXTERNAL CGEMM, CGETF2, CLASWP, CTRSM, XERBLA 00069 * .. 00070 * .. External Functions .. 00071 INTEGER ILAENV 00072 EXTERNAL ILAENV 00073 * .. 00074 * .. Intrinsic Functions .. 00075 INTRINSIC MAX, MIN, MOD 00076 * .. 00077 * .. Executable Statements .. 00078 * 00079 * Test the input parameters. 00080 * 00081 INFO = 0 00082 IF( M.LT.0 ) THEN 00083 INFO = -1 00084 ELSE IF( N.LT.0 ) THEN 00085 INFO = -2 00086 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN 00087 INFO = -4 00088 END IF 00089 IF( INFO.NE.0 ) THEN 00090 CALL XERBLA( 'CGETRF', -INFO ) 00091 RETURN 00092 END IF 00093 * 00094 * Quick return if possible 00095 * 00096 IF( M.EQ.0 .OR. N.EQ.0 ) 00097 $ RETURN 00098 * 00099 * Determine the block size for this environment. 00100 * 00101 NB = ILAENV( 1, 'CGETRF', ' ', M, N, -1, -1 ) 00102 IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN 00103 * 00104 * Use unblocked code. 00105 * 00106 CALL CGETF2( M, N, A, LDA, IPIV, INFO ) 00107 ELSE 00108 * 00109 * Use blocked code. 00110 * 00111 DO 20 J = 1, MIN( M, N ), NB 00112 JB = MIN( MIN( M, N )-J+1, NB ) 00113 * 00114 * Update current block. 00115 * 00116 CALL CGEMM( 'No transpose', 'No transpose', 00117 $ M-J+1, JB, J-1, -ONE, 00118 $ A( J, 1 ), LDA, A( 1, J ), LDA, ONE, 00119 $ A( J, J ), LDA ) 00120 00121 * 00122 * Factor diagonal and subdiagonal blocks and test for exact 00123 * singularity. 00124 * 00125 CALL CGETF2( M-J+1, JB, A( J, J ), LDA, IPIV( J ), IINFO ) 00126 * 00127 * Adjust INFO and the pivot indices. 00128 * 00129 IF( INFO.EQ.0 .AND. IINFO.GT.0 ) 00130 $ INFO = IINFO + J - 1 00131 DO 10 I = J, MIN( M, J+JB-1 ) 00132 IPIV( I ) = J - 1 + IPIV( I ) 00133 10 CONTINUE 00134 * 00135 * Apply interchanges to column 1:J-1 00136 * 00137 CALL CLASWP( J-1, A, LDA, J, J+JB-1, IPIV, 1 ) 00138 * 00139 IF ( J+JB.LE.N ) THEN 00140 * 00141 * Apply interchanges to column J+JB:N 00142 * 00143 CALL CLASWP( N-J-JB+1, A( 1, J+JB ), LDA, J, J+JB-1, 00144 $ IPIV, 1 ) 00145 * 00146 CALL CGEMM( 'No transpose', 'No transpose', 00147 $ JB, N-J-JB+1, J-1, -ONE, 00148 $ A( J, 1 ), LDA, A( 1, J+JB ), LDA, ONE, 00149 $ A( J, J+JB ), LDA ) 00150 * 00151 * Compute block row of U. 00152 * 00153 CALL CTRSM( 'Left', 'Lower', 'No transpose', 'Unit', 00154 $ JB, N-J-JB+1, ONE, A( J, J ), LDA, 00155 $ A( J, J+JB ), LDA ) 00156 END IF 00157 00158 20 CONTINUE 00159 00160 END IF 00161 RETURN 00162 * 00163 * End of CGETRF 00164 * 00165 END