LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
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 minor of order k is not
75 *> positive definite; 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 *> \date September 2012
89 *
90 *> \ingroup complexPTcomputational
91 *
92 * =====================================================================
93  SUBROUTINE cpttrf( N, D, E, INFO )
94 *
95 * -- LAPACK computational routine (version 3.4.2) --
96 * -- LAPACK is a software package provided by Univ. of Tennessee, --
97 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
98 * September 2012
99 *
100 * .. Scalar Arguments ..
101  INTEGER info, n
102 * ..
103 * .. Array Arguments ..
104  REAL d( * )
105  COMPLEX e( * )
106 * ..
107 *
108 * =====================================================================
109 *
110 * .. Parameters ..
111  REAL zero
112  parameter( zero = 0.0e+0 )
113 * ..
114 * .. Local Scalars ..
115  INTEGER i, i4
116  REAL eii, eir, f, g
117 * ..
118 * .. External Subroutines ..
119  EXTERNAL xerbla
120 * ..
121 * .. Intrinsic Functions ..
122  INTRINSIC aimag, cmplx, mod, real
123 * ..
124 * .. Executable Statements ..
125 *
126 * Test the input parameters.
127 *
128  info = 0
129  IF( n.LT.0 ) THEN
130  info = -1
131  CALL xerbla( 'CPTTRF', -info )
132  RETURN
133  END IF
134 *
135 * Quick return if possible
136 *
137  IF( n.EQ.0 )
138  $ RETURN
139 *
140 * Compute the L*D*L**H (or U**H *D*U) factorization of A.
141 *
142  i4 = mod( n-1, 4 )
143  DO 10 i = 1, i4
144  IF( d( i ).LE.zero ) THEN
145  info = i
146  go to 20
147  END IF
148  eir = REAL( E( I ) )
149  eii = aimag( e( i ) )
150  f = eir / d( i )
151  g = eii / d( i )
152  e( i ) = cmplx( f, g )
153  d( i+1 ) = d( i+1 ) - f*eir - g*eii
154  10 CONTINUE
155 *
156  DO 110 i = i4+1, n - 4, 4
157 *
158 * Drop out of the loop if d(i) <= 0: the matrix is not positive
159 * definite.
160 *
161  IF( d( i ).LE.zero ) THEN
162  info = i
163  go to 20
164  END IF
165 *
166 * Solve for e(i) and d(i+1).
167 *
168  eir = REAL( E( I ) )
169  eii = aimag( e( i ) )
170  f = eir / d( i )
171  g = eii / d( i )
172  e( i ) = cmplx( f, g )
173  d( i+1 ) = d( i+1 ) - f*eir - g*eii
174 *
175  IF( d( i+1 ).LE.zero ) THEN
176  info = i+1
177  go to 20
178  END IF
179 *
180 * Solve for e(i+1) and d(i+2).
181 *
182  eir = REAL( E( I+1 ) )
183  eii = aimag( e( i+1 ) )
184  f = eir / d( i+1 )
185  g = eii / d( i+1 )
186  e( i+1 ) = cmplx( f, g )
187  d( i+2 ) = d( i+2 ) - f*eir - g*eii
188 *
189  IF( d( i+2 ).LE.zero ) THEN
190  info = i+2
191  go to 20
192  END IF
193 *
194 * Solve for e(i+2) and d(i+3).
195 *
196  eir = REAL( E( I+2 ) )
197  eii = aimag( e( i+2 ) )
198  f = eir / d( i+2 )
199  g = eii / d( i+2 )
200  e( i+2 ) = cmplx( f, g )
201  d( i+3 ) = d( i+3 ) - f*eir - g*eii
202 *
203  IF( d( i+3 ).LE.zero ) THEN
204  info = i+3
205  go to 20
206  END IF
207 *
208 * Solve for e(i+3) and d(i+4).
209 *
210  eir = REAL( E( I+3 ) )
211  eii = aimag( e( i+3 ) )
212  f = eir / d( i+3 )
213  g = eii / d( i+3 )
214  e( i+3 ) = cmplx( f, g )
215  d( i+4 ) = d( i+4 ) - f*eir - g*eii
216  110 CONTINUE
217 *
218 * Check d(n) for positive definiteness.
219 *
220  IF( d( n ).LE.zero )
221  $ info = n
222 *
223  20 CONTINUE
224  RETURN
225 *
226 * End of CPTTRF
227 *
228  END