LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cpttrf.f
Go to the documentation of this file.
1*> \brief \b CPTTRF
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CPTTRF + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cpttrf.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cpttrf.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cpttrf.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE CPTTRF( N, D, E, INFO )
22*
23* .. Scalar Arguments ..
24* INTEGER INFO, N
25* ..
26* .. Array Arguments ..
27* REAL D( * )
28* COMPLEX E( * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> CPTTRF computes the L*D*L**H factorization of a complex Hermitian
38*> positive definite tridiagonal matrix A. The factorization may also
39*> be regarded as having the form A = U**H *D*U.
40*> \endverbatim
41*
42* Arguments:
43* ==========
44*
45*> \param[in] N
46*> \verbatim
47*> N is INTEGER
48*> The order of the matrix A. N >= 0.
49*> \endverbatim
50*>
51*> \param[in,out] D
52*> \verbatim
53*> D is REAL array, dimension (N)
54*> On entry, the n diagonal elements of the tridiagonal matrix
55*> A. On exit, the n diagonal elements of the diagonal matrix
56*> D from the L*D*L**H factorization of A.
57*> \endverbatim
58*>
59*> \param[in,out] E
60*> \verbatim
61*> E is COMPLEX array, dimension (N-1)
62*> On entry, the (n-1) subdiagonal elements of the tridiagonal
63*> matrix A. On exit, the (n-1) subdiagonal elements of the
64*> unit bidiagonal factor L from the L*D*L**H factorization of A.
65*> E can also be regarded as the superdiagonal of the unit
66*> bidiagonal factor U from the U**H *D*U factorization of A.
67*> \endverbatim
68*>
69*> \param[out] INFO
70*> \verbatim
71*> INFO is INTEGER
72*> = 0: successful exit
73*> < 0: if INFO = -k, the k-th argument had an illegal value
74*> > 0: if INFO = k, the leading principal minor of order k
75*> is not positive; if k < N, the factorization could not
76*> be completed, while if k = N, the factorization was
77*> completed, but D(N) <= 0.
78*> \endverbatim
79*
80* Authors:
81* ========
82*
83*> \author Univ. of Tennessee
84*> \author Univ. of California Berkeley
85*> \author Univ. of Colorado Denver
86*> \author NAG Ltd.
87*
88*> \ingroup pttrf
89*
90* =====================================================================
91 SUBROUTINE cpttrf( N, D, E, INFO )
92*
93* -- LAPACK computational routine --
94* -- LAPACK is a software package provided by Univ. of Tennessee, --
95* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
96*
97* .. Scalar Arguments ..
98 INTEGER INFO, N
99* ..
100* .. Array Arguments ..
101 REAL D( * )
102 COMPLEX E( * )
103* ..
104*
105* =====================================================================
106*
107* .. Parameters ..
108 REAL ZERO
109 parameter( zero = 0.0e+0 )
110* ..
111* .. Local Scalars ..
112 INTEGER I, I4
113 REAL EII, EIR, F, G
114* ..
115* .. External Subroutines ..
116 EXTERNAL xerbla
117* ..
118* .. Intrinsic Functions ..
119 INTRINSIC aimag, cmplx, mod, real
120* ..
121* .. Executable Statements ..
122*
123* Test the input parameters.
124*
125 info = 0
126 IF( n.LT.0 ) THEN
127 info = -1
128 CALL xerbla( 'CPTTRF', -info )
129 RETURN
130 END IF
131*
132* Quick return if possible
133*
134 IF( n.EQ.0 )
135 $ RETURN
136*
137* Compute the L*D*L**H (or U**H *D*U) factorization of A.
138*
139 i4 = mod( n-1, 4 )
140 DO 10 i = 1, i4
141 IF( d( i ).LE.zero ) THEN
142 info = i
143 GO TO 20
144 END IF
145 eir = real( e( i ) )
146 eii = aimag( e( i ) )
147 f = eir / d( i )
148 g = eii / d( i )
149 e( i ) = cmplx( f, g )
150 d( i+1 ) = d( i+1 ) - f*eir - g*eii
151 10 CONTINUE
152*
153 DO 110 i = i4+1, n - 4, 4
154*
155* Drop out of the loop if d(i) <= 0: the matrix is not positive
156* definite.
157*
158 IF( d( i ).LE.zero ) THEN
159 info = i
160 GO TO 20
161 END IF
162*
163* Solve for e(i) and d(i+1).
164*
165 eir = real( e( i ) )
166 eii = aimag( e( i ) )
167 f = eir / d( i )
168 g = eii / d( i )
169 e( i ) = cmplx( f, g )
170 d( i+1 ) = d( i+1 ) - f*eir - g*eii
171*
172 IF( d( i+1 ).LE.zero ) THEN
173 info = i+1
174 GO TO 20
175 END IF
176*
177* Solve for e(i+1) and d(i+2).
178*
179 eir = real( e( i+1 ) )
180 eii = aimag( e( i+1 ) )
181 f = eir / d( i+1 )
182 g = eii / d( i+1 )
183 e( i+1 ) = cmplx( f, g )
184 d( i+2 ) = d( i+2 ) - f*eir - g*eii
185*
186 IF( d( i+2 ).LE.zero ) THEN
187 info = i+2
188 GO TO 20
189 END IF
190*
191* Solve for e(i+2) and d(i+3).
192*
193 eir = real( e( i+2 ) )
194 eii = aimag( e( i+2 ) )
195 f = eir / d( i+2 )
196 g = eii / d( i+2 )
197 e( i+2 ) = cmplx( f, g )
198 d( i+3 ) = d( i+3 ) - f*eir - g*eii
199*
200 IF( d( i+3 ).LE.zero ) THEN
201 info = i+3
202 GO TO 20
203 END IF
204*
205* Solve for e(i+3) and d(i+4).
206*
207 eir = real( e( i+3 ) )
208 eii = aimag( e( i+3 ) )
209 f = eir / d( i+3 )
210 g = eii / d( i+3 )
211 e( i+3 ) = cmplx( f, g )
212 d( i+4 ) = d( i+4 ) - f*eir - g*eii
213 110 CONTINUE
214*
215* Check d(n) for positive definiteness.
216*
217 IF( d( n ).LE.zero )
218 $ info = n
219*
220 20 CONTINUE
221 RETURN
222*
223* End of CPTTRF
224*
225 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine cpttrf(n, d, e, info)
CPTTRF
Definition cpttrf.f:92