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