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