LAPACK 3.3.0
|
00001 SUBROUTINE ZGETRI( N, A, LDA, IPIV, WORK, LWORK, 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, LWORK, N 00010 * .. 00011 * .. Array Arguments .. 00012 INTEGER IPIV( * ) 00013 COMPLEX*16 A( LDA, * ), WORK( * ) 00014 * .. 00015 * 00016 * Purpose 00017 * ======= 00018 * 00019 * ZGETRI computes the inverse of a matrix using the LU factorization 00020 * computed by ZGETRF. 00021 * 00022 * This method inverts U and then computes inv(A) by solving the system 00023 * inv(A)*L = inv(U) for inv(A). 00024 * 00025 * Arguments 00026 * ========= 00027 * 00028 * N (input) INTEGER 00029 * The order of the matrix A. N >= 0. 00030 * 00031 * A (input/output) COMPLEX*16 array, dimension (LDA,N) 00032 * On entry, the factors L and U from the factorization 00033 * A = P*L*U as computed by ZGETRF. 00034 * On exit, if INFO = 0, the inverse of the original matrix A. 00035 * 00036 * LDA (input) INTEGER 00037 * The leading dimension of the array A. LDA >= max(1,N). 00038 * 00039 * IPIV (input) INTEGER array, dimension (N) 00040 * The pivot indices from ZGETRF; for 1<=i<=N, row i of the 00041 * matrix was interchanged with row IPIV(i). 00042 * 00043 * WORK (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK)) 00044 * On exit, if INFO=0, then WORK(1) returns the optimal LWORK. 00045 * 00046 * LWORK (input) INTEGER 00047 * The dimension of the array WORK. LWORK >= max(1,N). 00048 * For optimal performance LWORK >= N*NB, where NB is 00049 * the optimal blocksize returned by ILAENV. 00050 * 00051 * If LWORK = -1, then a workspace query is assumed; the routine 00052 * only calculates the optimal size of the WORK array, returns 00053 * this value as the first entry of the WORK array, and no error 00054 * message related to LWORK is issued by XERBLA. 00055 * 00056 * INFO (output) INTEGER 00057 * = 0: successful exit 00058 * < 0: if INFO = -i, the i-th argument had an illegal value 00059 * > 0: if INFO = i, U(i,i) is exactly zero; the matrix is 00060 * singular and its inverse could not be computed. 00061 * 00062 * ===================================================================== 00063 * 00064 * .. Parameters .. 00065 COMPLEX*16 ZERO, ONE 00066 PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ), 00067 $ ONE = ( 1.0D+0, 0.0D+0 ) ) 00068 * .. 00069 * .. Local Scalars .. 00070 LOGICAL LQUERY 00071 INTEGER I, IWS, J, JB, JJ, JP, LDWORK, LWKOPT, NB, 00072 $ NBMIN, NN 00073 * .. 00074 * .. External Functions .. 00075 INTEGER ILAENV 00076 EXTERNAL ILAENV 00077 * .. 00078 * .. External Subroutines .. 00079 EXTERNAL XERBLA, ZGEMM, ZGEMV, ZSWAP, ZTRSM, ZTRTRI 00080 * .. 00081 * .. Intrinsic Functions .. 00082 INTRINSIC MAX, MIN 00083 * .. 00084 * .. Executable Statements .. 00085 * 00086 * Test the input parameters. 00087 * 00088 INFO = 0 00089 NB = ILAENV( 1, 'ZGETRI', ' ', N, -1, -1, -1 ) 00090 LWKOPT = N*NB 00091 WORK( 1 ) = LWKOPT 00092 LQUERY = ( LWORK.EQ.-1 ) 00093 IF( N.LT.0 ) THEN 00094 INFO = -1 00095 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00096 INFO = -3 00097 ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN 00098 INFO = -6 00099 END IF 00100 IF( INFO.NE.0 ) THEN 00101 CALL XERBLA( 'ZGETRI', -INFO ) 00102 RETURN 00103 ELSE IF( LQUERY ) THEN 00104 RETURN 00105 END IF 00106 * 00107 * Quick return if possible 00108 * 00109 IF( N.EQ.0 ) 00110 $ RETURN 00111 * 00112 * Form inv(U). If INFO > 0 from ZTRTRI, then U is singular, 00113 * and the inverse is not computed. 00114 * 00115 CALL ZTRTRI( 'Upper', 'Non-unit', N, A, LDA, INFO ) 00116 IF( INFO.GT.0 ) 00117 $ RETURN 00118 * 00119 NBMIN = 2 00120 LDWORK = N 00121 IF( NB.GT.1 .AND. NB.LT.N ) THEN 00122 IWS = MAX( LDWORK*NB, 1 ) 00123 IF( LWORK.LT.IWS ) THEN 00124 NB = LWORK / LDWORK 00125 NBMIN = MAX( 2, ILAENV( 2, 'ZGETRI', ' ', N, -1, -1, -1 ) ) 00126 END IF 00127 ELSE 00128 IWS = N 00129 END IF 00130 * 00131 * Solve the equation inv(A)*L = inv(U) for inv(A). 00132 * 00133 IF( NB.LT.NBMIN .OR. NB.GE.N ) THEN 00134 * 00135 * Use unblocked code. 00136 * 00137 DO 20 J = N, 1, -1 00138 * 00139 * Copy current column of L to WORK and replace with zeros. 00140 * 00141 DO 10 I = J + 1, N 00142 WORK( I ) = A( I, J ) 00143 A( I, J ) = ZERO 00144 10 CONTINUE 00145 * 00146 * Compute current column of inv(A). 00147 * 00148 IF( J.LT.N ) 00149 $ CALL ZGEMV( 'No transpose', N, N-J, -ONE, A( 1, J+1 ), 00150 $ LDA, WORK( J+1 ), 1, ONE, A( 1, J ), 1 ) 00151 20 CONTINUE 00152 ELSE 00153 * 00154 * Use blocked code. 00155 * 00156 NN = ( ( N-1 ) / NB )*NB + 1 00157 DO 50 J = NN, 1, -NB 00158 JB = MIN( NB, N-J+1 ) 00159 * 00160 * Copy current block column of L to WORK and replace with 00161 * zeros. 00162 * 00163 DO 40 JJ = J, J + JB - 1 00164 DO 30 I = JJ + 1, N 00165 WORK( I+( JJ-J )*LDWORK ) = A( I, JJ ) 00166 A( I, JJ ) = ZERO 00167 30 CONTINUE 00168 40 CONTINUE 00169 * 00170 * Compute current block column of inv(A). 00171 * 00172 IF( J+JB.LE.N ) 00173 $ CALL ZGEMM( 'No transpose', 'No transpose', N, JB, 00174 $ N-J-JB+1, -ONE, A( 1, J+JB ), LDA, 00175 $ WORK( J+JB ), LDWORK, ONE, A( 1, J ), LDA ) 00176 CALL ZTRSM( 'Right', 'Lower', 'No transpose', 'Unit', N, JB, 00177 $ ONE, WORK( J ), LDWORK, A( 1, J ), LDA ) 00178 50 CONTINUE 00179 END IF 00180 * 00181 * Apply column interchanges. 00182 * 00183 DO 60 J = N - 1, 1, -1 00184 JP = IPIV( J ) 00185 IF( JP.NE.J ) 00186 $ CALL ZSWAP( N, A( 1, J ), 1, A( 1, JP ), 1 ) 00187 60 CONTINUE 00188 * 00189 WORK( 1 ) = IWS 00190 RETURN 00191 * 00192 * End of ZGETRI 00193 * 00194 END