![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b STRTRI 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download STRTRI + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/strtri.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/strtri.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/strtri.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE STRTRI( UPLO, DIAG, N, A, LDA, INFO ) 00022 * 00023 * .. Scalar Arguments .. 00024 * CHARACTER DIAG, UPLO 00025 * INTEGER INFO, LDA, N 00026 * .. 00027 * .. Array Arguments .. 00028 * REAL A( LDA, * ) 00029 * .. 00030 * 00031 * 00032 *> \par Purpose: 00033 * ============= 00034 *> 00035 *> \verbatim 00036 *> 00037 *> STRTRI computes the inverse of a real upper or lower triangular 00038 *> matrix A. 00039 *> 00040 *> This is the Level 3 BLAS version of the algorithm. 00041 *> \endverbatim 00042 * 00043 * Arguments: 00044 * ========== 00045 * 00046 *> \param[in] UPLO 00047 *> \verbatim 00048 *> UPLO is CHARACTER*1 00049 *> = 'U': A is upper triangular; 00050 *> = 'L': A is lower triangular. 00051 *> \endverbatim 00052 *> 00053 *> \param[in] DIAG 00054 *> \verbatim 00055 *> DIAG is CHARACTER*1 00056 *> = 'N': A is non-unit triangular; 00057 *> = 'U': A is unit triangular. 00058 *> \endverbatim 00059 *> 00060 *> \param[in] N 00061 *> \verbatim 00062 *> N is INTEGER 00063 *> The order of the matrix A. N >= 0. 00064 *> \endverbatim 00065 *> 00066 *> \param[in,out] A 00067 *> \verbatim 00068 *> A is REAL array, dimension (LDA,N) 00069 *> On entry, the triangular matrix A. If UPLO = 'U', the 00070 *> leading N-by-N upper triangular part of the array A contains 00071 *> the upper triangular matrix, and the strictly lower 00072 *> triangular part of A is not referenced. If UPLO = 'L', the 00073 *> leading N-by-N lower triangular part of the array A contains 00074 *> the lower triangular matrix, and the strictly upper 00075 *> triangular part of A is not referenced. If DIAG = 'U', the 00076 *> diagonal elements of A are also not referenced and are 00077 *> assumed to be 1. 00078 *> On exit, the (triangular) inverse of the original matrix, in 00079 *> the same storage format. 00080 *> \endverbatim 00081 *> 00082 *> \param[in] LDA 00083 *> \verbatim 00084 *> LDA is INTEGER 00085 *> The leading dimension of the array A. LDA >= max(1,N). 00086 *> \endverbatim 00087 *> 00088 *> \param[out] INFO 00089 *> \verbatim 00090 *> INFO is INTEGER 00091 *> = 0: successful exit 00092 *> < 0: if INFO = -i, the i-th argument had an illegal value 00093 *> > 0: if INFO = i, A(i,i) is exactly zero. The triangular 00094 *> matrix is singular and its inverse can not be computed. 00095 *> \endverbatim 00096 * 00097 * Authors: 00098 * ======== 00099 * 00100 *> \author Univ. of Tennessee 00101 *> \author Univ. of California Berkeley 00102 *> \author Univ. of Colorado Denver 00103 *> \author NAG Ltd. 00104 * 00105 *> \date November 2011 00106 * 00107 *> \ingroup realOTHERcomputational 00108 * 00109 * ===================================================================== 00110 SUBROUTINE STRTRI( UPLO, DIAG, N, A, LDA, INFO ) 00111 * 00112 * -- LAPACK computational routine (version 3.4.0) -- 00113 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00114 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00115 * November 2011 00116 * 00117 * .. Scalar Arguments .. 00118 CHARACTER DIAG, UPLO 00119 INTEGER INFO, LDA, N 00120 * .. 00121 * .. Array Arguments .. 00122 REAL A( LDA, * ) 00123 * .. 00124 * 00125 * ===================================================================== 00126 * 00127 * .. Parameters .. 00128 REAL ONE, ZERO 00129 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00130 * .. 00131 * .. Local Scalars .. 00132 LOGICAL NOUNIT, UPPER 00133 INTEGER J, JB, NB, NN 00134 * .. 00135 * .. External Functions .. 00136 LOGICAL LSAME 00137 INTEGER ILAENV 00138 EXTERNAL LSAME, ILAENV 00139 * .. 00140 * .. External Subroutines .. 00141 EXTERNAL STRMM, STRSM, STRTI2, XERBLA 00142 * .. 00143 * .. Intrinsic Functions .. 00144 INTRINSIC MAX, MIN 00145 * .. 00146 * .. Executable Statements .. 00147 * 00148 * Test the input parameters. 00149 * 00150 INFO = 0 00151 UPPER = LSAME( UPLO, 'U' ) 00152 NOUNIT = LSAME( DIAG, 'N' ) 00153 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00154 INFO = -1 00155 ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN 00156 INFO = -2 00157 ELSE IF( N.LT.0 ) THEN 00158 INFO = -3 00159 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00160 INFO = -5 00161 END IF 00162 IF( INFO.NE.0 ) THEN 00163 CALL XERBLA( 'STRTRI', -INFO ) 00164 RETURN 00165 END IF 00166 * 00167 * Quick return if possible 00168 * 00169 IF( N.EQ.0 ) 00170 $ RETURN 00171 * 00172 * Check for singularity if non-unit. 00173 * 00174 IF( NOUNIT ) THEN 00175 DO 10 INFO = 1, N 00176 IF( A( INFO, INFO ).EQ.ZERO ) 00177 $ RETURN 00178 10 CONTINUE 00179 INFO = 0 00180 END IF 00181 * 00182 * Determine the block size for this environment. 00183 * 00184 NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 ) 00185 IF( NB.LE.1 .OR. NB.GE.N ) THEN 00186 * 00187 * Use unblocked code 00188 * 00189 CALL STRTI2( UPLO, DIAG, N, A, LDA, INFO ) 00190 ELSE 00191 * 00192 * Use blocked code 00193 * 00194 IF( UPPER ) THEN 00195 * 00196 * Compute inverse of upper triangular matrix 00197 * 00198 DO 20 J = 1, N, NB 00199 JB = MIN( NB, N-J+1 ) 00200 * 00201 * Compute rows 1:j-1 of current block column 00202 * 00203 CALL STRMM( 'Left', 'Upper', 'No transpose', DIAG, J-1, 00204 $ JB, ONE, A, LDA, A( 1, J ), LDA ) 00205 CALL STRSM( 'Right', 'Upper', 'No transpose', DIAG, J-1, 00206 $ JB, -ONE, A( J, J ), LDA, A( 1, J ), LDA ) 00207 * 00208 * Compute inverse of current diagonal block 00209 * 00210 CALL STRTI2( 'Upper', DIAG, JB, A( J, J ), LDA, INFO ) 00211 20 CONTINUE 00212 ELSE 00213 * 00214 * Compute inverse of lower triangular matrix 00215 * 00216 NN = ( ( N-1 ) / NB )*NB + 1 00217 DO 30 J = NN, 1, -NB 00218 JB = MIN( NB, N-J+1 ) 00219 IF( J+JB.LE.N ) THEN 00220 * 00221 * Compute rows j+jb:n of current block column 00222 * 00223 CALL STRMM( 'Left', 'Lower', 'No transpose', DIAG, 00224 $ N-J-JB+1, JB, ONE, A( J+JB, J+JB ), LDA, 00225 $ A( J+JB, J ), LDA ) 00226 CALL STRSM( 'Right', 'Lower', 'No transpose', DIAG, 00227 $ N-J-JB+1, JB, -ONE, A( J, J ), LDA, 00228 $ A( J+JB, J ), LDA ) 00229 END IF 00230 * 00231 * Compute inverse of current diagonal block 00232 * 00233 CALL STRTI2( 'Lower', DIAG, JB, A( J, J ), LDA, INFO ) 00234 30 CONTINUE 00235 END IF 00236 END IF 00237 * 00238 RETURN 00239 * 00240 * End of STRTRI 00241 * 00242 END