LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
ctrtri.f
Go to the documentation of this file.
1*> \brief \b CTRTRI
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CTRTRI + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ctrtri.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ctrtri.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ctrtri.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE CTRTRI( UPLO, DIAG, N, A, LDA, INFO )
22*
23* .. Scalar Arguments ..
24* CHARACTER DIAG, UPLO
25* INTEGER INFO, LDA, N
26* ..
27* .. Array Arguments ..
28* COMPLEX A( LDA, * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> CTRTRI computes the inverse of a complex upper or lower triangular
38*> matrix A.
39*>
40*> This is the Level 3 BLAS version of the algorithm.
41*> \endverbatim
42*
43* Arguments:
44* ==========
45*
46*> \param[in] UPLO
47*> \verbatim
48*> UPLO is CHARACTER*1
49*> = 'U': A is upper triangular;
50*> = 'L': A is lower triangular.
51*> \endverbatim
52*>
53*> \param[in] DIAG
54*> \verbatim
55*> DIAG is CHARACTER*1
56*> = 'N': A is non-unit triangular;
57*> = 'U': A is unit triangular.
58*> \endverbatim
59*>
60*> \param[in] N
61*> \verbatim
62*> N is INTEGER
63*> The order of the matrix A. N >= 0.
64*> \endverbatim
65*>
66*> \param[in,out] A
67*> \verbatim
68*> A is COMPLEX array, dimension (LDA,N)
69*> On entry, the triangular matrix A. If UPLO = 'U', the
70*> leading N-by-N upper triangular part of the array A contains
71*> the upper triangular matrix, and the strictly lower
72*> triangular part of A is not referenced. If UPLO = 'L', the
73*> leading N-by-N lower triangular part of the array A contains
74*> the lower triangular matrix, and the strictly upper
75*> triangular part of A is not referenced. If DIAG = 'U', the
76*> diagonal elements of A are also not referenced and are
77*> assumed to be 1.
78*> On exit, the (triangular) inverse of the original matrix, in
79*> the same storage format.
80*> \endverbatim
81*>
82*> \param[in] LDA
83*> \verbatim
84*> LDA is INTEGER
85*> The leading dimension of the array A. LDA >= max(1,N).
86*> \endverbatim
87*>
88*> \param[out] INFO
89*> \verbatim
90*> INFO is INTEGER
91*> = 0: successful exit
92*> < 0: if INFO = -i, the i-th argument had an illegal value
93*> > 0: if INFO = i, A(i,i) is exactly zero. The triangular
94*> matrix is singular and its inverse can not be computed.
95*> \endverbatim
96*
97* Authors:
98* ========
99*
100*> \author Univ. of Tennessee
101*> \author Univ. of California Berkeley
102*> \author Univ. of Colorado Denver
103*> \author NAG Ltd.
104*
105*> \ingroup trtri
106*
107* =====================================================================
108 SUBROUTINE ctrtri( UPLO, DIAG, N, A, LDA, INFO )
109*
110* -- LAPACK computational routine --
111* -- LAPACK is a software package provided by Univ. of Tennessee, --
112* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
113*
114* .. Scalar Arguments ..
115 CHARACTER DIAG, UPLO
116 INTEGER INFO, LDA, N
117* ..
118* .. Array Arguments ..
119 COMPLEX A( LDA, * )
120* ..
121*
122* =====================================================================
123*
124* .. Parameters ..
125 COMPLEX ONE, ZERO
126 parameter( one = ( 1.0e+0, 0.0e+0 ),
127 $ zero = ( 0.0e+0, 0.0e+0 ) )
128* ..
129* .. Local Scalars ..
130 LOGICAL NOUNIT, UPPER
131 INTEGER J, JB, NB, NN
132* ..
133* .. External Functions ..
134 LOGICAL LSAME
135 INTEGER ILAENV
136 EXTERNAL lsame, ilaenv
137* ..
138* .. External Subroutines ..
139 EXTERNAL ctrmm, ctrsm, ctrti2, xerbla
140* ..
141* .. Intrinsic Functions ..
142 INTRINSIC max, min
143* ..
144* .. Executable Statements ..
145*
146* Test the input parameters.
147*
148 info = 0
149 upper = lsame( uplo, 'U' )
150 nounit = lsame( diag, 'N' )
151 IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
152 info = -1
153 ELSE IF( .NOT.nounit .AND. .NOT.lsame( diag, 'U' ) ) THEN
154 info = -2
155 ELSE IF( n.LT.0 ) THEN
156 info = -3
157 ELSE IF( lda.LT.max( 1, n ) ) THEN
158 info = -5
159 END IF
160 IF( info.NE.0 ) THEN
161 CALL xerbla( 'CTRTRI', -info )
162 RETURN
163 END IF
164*
165* Quick return if possible
166*
167 IF( n.EQ.0 )
168 $ RETURN
169*
170* Check for singularity if non-unit.
171*
172 IF( nounit ) THEN
173 DO 10 info = 1, n
174 IF( a( info, info ).EQ.zero )
175 $ RETURN
176 10 CONTINUE
177 info = 0
178 END IF
179*
180* Determine the block size for this environment.
181*
182 nb = ilaenv( 1, 'CTRTRI', uplo // diag, n, -1, -1, -1 )
183 IF( nb.LE.1 .OR. nb.GE.n ) THEN
184*
185* Use unblocked code
186*
187 CALL ctrti2( uplo, diag, n, a, lda, info )
188 ELSE
189*
190* Use blocked code
191*
192 IF( upper ) THEN
193*
194* Compute inverse of upper triangular matrix
195*
196 DO 20 j = 1, n, nb
197 jb = min( nb, n-j+1 )
198*
199* Compute rows 1:j-1 of current block column
200*
201 CALL ctrmm( 'Left', 'Upper', 'No transpose', diag, j-1,
202 $ jb, one, a, lda, a( 1, j ), lda )
203 CALL ctrsm( 'Right', 'Upper', 'No transpose', diag, j-1,
204 $ jb, -one, a( j, j ), lda, a( 1, j ), lda )
205*
206* Compute inverse of current diagonal block
207*
208 CALL ctrti2( 'Upper', diag, jb, a( j, j ), lda, info )
209 20 CONTINUE
210 ELSE
211*
212* Compute inverse of lower triangular matrix
213*
214 nn = ( ( n-1 ) / nb )*nb + 1
215 DO 30 j = nn, 1, -nb
216 jb = min( nb, n-j+1 )
217 IF( j+jb.LE.n ) THEN
218*
219* Compute rows j+jb:n of current block column
220*
221 CALL ctrmm( 'Left', 'Lower', 'No transpose', diag,
222 $ n-j-jb+1, jb, one, a( j+jb, j+jb ), lda,
223 $ a( j+jb, j ), lda )
224 CALL ctrsm( 'Right', 'Lower', 'No transpose', diag,
225 $ n-j-jb+1, jb, -one, a( j, j ), lda,
226 $ a( j+jb, j ), lda )
227 END IF
228*
229* Compute inverse of current diagonal block
230*
231 CALL ctrti2( 'Lower', diag, jb, a( j, j ), lda, info )
232 30 CONTINUE
233 END IF
234 END IF
235*
236 RETURN
237*
238* End of CTRTRI
239*
240 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine ctrmm(side, uplo, transa, diag, m, n, alpha, a, lda, b, ldb)
CTRMM
Definition ctrmm.f:177
subroutine ctrsm(side, uplo, transa, diag, m, n, alpha, a, lda, b, ldb)
CTRSM
Definition ctrsm.f:180
subroutine ctrti2(uplo, diag, n, a, lda, info)
CTRTI2 computes the inverse of a triangular matrix (unblocked algorithm).
Definition ctrti2.f:110
subroutine ctrtri(uplo, diag, n, a, lda, info)
CTRTRI
Definition ctrtri.f:109