LAPACK 3.3.0
|
00001 SUBROUTINE ZTRTRI( UPLO, DIAG, N, A, LDA, 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 CHARACTER DIAG, UPLO 00010 INTEGER INFO, LDA, N 00011 * .. 00012 * .. Array Arguments .. 00013 COMPLEX*16 A( LDA, * ) 00014 * .. 00015 * 00016 * Purpose 00017 * ======= 00018 * 00019 * ZTRTRI computes the inverse of a complex upper or lower triangular 00020 * matrix A. 00021 * 00022 * This is the Level 3 BLAS version of the algorithm. 00023 * 00024 * Arguments 00025 * ========= 00026 * 00027 * UPLO (input) CHARACTER*1 00028 * = 'U': A is upper triangular; 00029 * = 'L': A is lower triangular. 00030 * 00031 * DIAG (input) CHARACTER*1 00032 * = 'N': A is non-unit triangular; 00033 * = 'U': A is unit triangular. 00034 * 00035 * N (input) INTEGER 00036 * The order of the matrix A. N >= 0. 00037 * 00038 * A (input/output) COMPLEX*16 array, dimension (LDA,N) 00039 * On entry, the triangular matrix A. If UPLO = 'U', the 00040 * leading N-by-N upper triangular part of the array A contains 00041 * the upper triangular matrix, and the strictly lower 00042 * triangular part of A is not referenced. If UPLO = 'L', the 00043 * leading N-by-N lower triangular part of the array A contains 00044 * the lower triangular matrix, and the strictly upper 00045 * triangular part of A is not referenced. If DIAG = 'U', the 00046 * diagonal elements of A are also not referenced and are 00047 * assumed to be 1. 00048 * On exit, the (triangular) inverse of the original matrix, in 00049 * the same storage format. 00050 * 00051 * LDA (input) INTEGER 00052 * The leading dimension of the array A. LDA >= max(1,N). 00053 * 00054 * INFO (output) INTEGER 00055 * = 0: successful exit 00056 * < 0: if INFO = -i, the i-th argument had an illegal value 00057 * > 0: if INFO = i, A(i,i) is exactly zero. The triangular 00058 * matrix is singular and its inverse can not be computed. 00059 * 00060 * ===================================================================== 00061 * 00062 * .. Parameters .. 00063 COMPLEX*16 ONE, ZERO 00064 PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ), 00065 $ ZERO = ( 0.0D+0, 0.0D+0 ) ) 00066 * .. 00067 * .. Local Scalars .. 00068 LOGICAL NOUNIT, UPPER 00069 INTEGER J, JB, NB, NN 00070 * .. 00071 * .. External Functions .. 00072 LOGICAL LSAME 00073 INTEGER ILAENV 00074 EXTERNAL LSAME, ILAENV 00075 * .. 00076 * .. External Subroutines .. 00077 EXTERNAL XERBLA, ZTRMM, ZTRSM, ZTRTI2 00078 * .. 00079 * .. Intrinsic Functions .. 00080 INTRINSIC MAX, MIN 00081 * .. 00082 * .. Executable Statements .. 00083 * 00084 * Test the input parameters. 00085 * 00086 INFO = 0 00087 UPPER = LSAME( UPLO, 'U' ) 00088 NOUNIT = LSAME( DIAG, 'N' ) 00089 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00090 INFO = -1 00091 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN 00092 INFO = -2 00093 ELSE IF( N.LT.0 ) THEN 00094 INFO = -3 00095 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00096 INFO = -5 00097 END IF 00098 IF( INFO.NE.0 ) THEN 00099 CALL XERBLA( 'ZTRTRI', -INFO ) 00100 RETURN 00101 END IF 00102 * 00103 * Quick return if possible 00104 * 00105 IF( N.EQ.0 ) 00106 $ RETURN 00107 * 00108 * Check for singularity if non-unit. 00109 * 00110 IF( NOUNIT ) THEN 00111 DO 10 INFO = 1, N 00112 IF( A( INFO, INFO ).EQ.ZERO ) 00113 $ RETURN 00114 10 CONTINUE 00115 INFO = 0 00116 END IF 00117 * 00118 * Determine the block size for this environment. 00119 * 00120 NB = ILAENV( 1, 'ZTRTRI', UPLO // DIAG, N, -1, -1, -1 ) 00121 IF( NB.LE.1 .OR. NB.GE.N ) THEN 00122 * 00123 * Use unblocked code 00124 * 00125 CALL ZTRTI2( UPLO, DIAG, N, A, LDA, INFO ) 00126 ELSE 00127 * 00128 * Use blocked code 00129 * 00130 IF( UPPER ) THEN 00131 * 00132 * Compute inverse of upper triangular matrix 00133 * 00134 DO 20 J = 1, N, NB 00135 JB = MIN( NB, N-J+1 ) 00136 * 00137 * Compute rows 1:j-1 of current block column 00138 * 00139 CALL ZTRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1, 00140 $ JB, ONE, A, LDA, A( 1, J ), LDA ) 00141 CALL ZTRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1, 00142 $ JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA ) 00143 * 00144 * Compute inverse of current diagonal block 00145 * 00146 CALL ZTRTI2( 'Upper', DIAG, JB, A( J, J ), LDA, INFO ) 00147 20 CONTINUE 00148 ELSE 00149 * 00150 * Compute inverse of lower triangular matrix 00151 * 00152 NN = ( ( N-1 ) / NB )*NB + 1 00153 DO 30 J = NN, 1, -NB 00154 JB = MIN( NB, N-J+1 ) 00155 IF( J+JB.LE.N ) THEN 00156 * 00157 * Compute rows j+jb:n of current block column 00158 * 00159 CALL ZTRMM( 'Left', 'Lower', 'No transpose', DIAG, 00160 $ N-J-JB+1, JB, ONE, A( J+JB, J+JB ), LDA, 00161 $ A( J+JB, J ), LDA ) 00162 CALL ZTRSM( 'Right', 'Lower', 'No transpose', DIAG, 00163 $ N-J-JB+1, JB, -ONE, A( J, J ), LDA, 00164 $ A( J+JB, J ), LDA ) 00165 END IF 00166 * 00167 * Compute inverse of current diagonal block 00168 * 00169 CALL ZTRTI2( 'Lower', DIAG, JB, A( J, J ), LDA, INFO ) 00170 30 CONTINUE 00171 END IF 00172 END IF 00173 * 00174 RETURN 00175 * 00176 * End of ZTRTRI 00177 * 00178 END