LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
zpttrf.f
Go to the documentation of this file.
1 *> \brief \b ZPTTRF
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download ZPTTRF + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zpttrf.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zpttrf.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zpttrf.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE ZPTTRF( N, D, E, INFO )
22 *
23 * .. Scalar Arguments ..
24 * INTEGER INFO, N
25 * ..
26 * .. Array Arguments ..
27 * DOUBLE PRECISION D( * )
28 * COMPLEX*16 E( * )
29 * ..
30 *
31 *
32 *> \par Purpose:
33 * =============
34 *>
35 *> \verbatim
36 *>
37 *> ZPTTRF 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 DOUBLE PRECISION 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*16 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 *> \ingroup complex16PTcomputational
89 *
90 * =====================================================================
91  SUBROUTINE zpttrf( 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  DOUBLE PRECISION D( * )
102  COMPLEX*16 E( * )
103 * ..
104 *
105 * =====================================================================
106 *
107 * .. Parameters ..
108  DOUBLE PRECISION ZERO
109  parameter( zero = 0.0d+0 )
110 * ..
111 * .. Local Scalars ..
112  INTEGER I, I4
113  DOUBLE PRECISION EII, EIR, F, G
114 * ..
115 * .. External Subroutines ..
116  EXTERNAL xerbla
117 * ..
118 * .. Intrinsic Functions ..
119  INTRINSIC dble, dcmplx, dimag, mod
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( 'ZPTTRF', -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 30
144  END IF
145  eir = dble( e( i ) )
146  eii = dimag( e( i ) )
147  f = eir / d( i )
148  g = eii / d( i )
149  e( i ) = dcmplx( f, g )
150  d( i+1 ) = d( i+1 ) - f*eir - g*eii
151  10 CONTINUE
152 *
153  DO 20 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 30
161  END IF
162 *
163 * Solve for e(i) and d(i+1).
164 *
165  eir = dble( e( i ) )
166  eii = dimag( e( i ) )
167  f = eir / d( i )
168  g = eii / d( i )
169  e( i ) = dcmplx( 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 30
175  END IF
176 *
177 * Solve for e(i+1) and d(i+2).
178 *
179  eir = dble( e( i+1 ) )
180  eii = dimag( e( i+1 ) )
181  f = eir / d( i+1 )
182  g = eii / d( i+1 )
183  e( i+1 ) = dcmplx( 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 30
189  END IF
190 *
191 * Solve for e(i+2) and d(i+3).
192 *
193  eir = dble( e( i+2 ) )
194  eii = dimag( e( i+2 ) )
195  f = eir / d( i+2 )
196  g = eii / d( i+2 )
197  e( i+2 ) = dcmplx( 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 30
203  END IF
204 *
205 * Solve for e(i+3) and d(i+4).
206 *
207  eir = dble( e( i+3 ) )
208  eii = dimag( e( i+3 ) )
209  f = eir / d( i+3 )
210  g = eii / d( i+3 )
211  e( i+3 ) = dcmplx( f, g )
212  d( i+4 ) = d( i+4 ) - f*eir - g*eii
213  20 CONTINUE
214 *
215 * Check d(n) for positive definiteness.
216 *
217  IF( d( n ).LE.zero )
218  $ info = n
219 *
220  30 CONTINUE
221  RETURN
222 *
223 * End of ZPTTRF
224 *
225  END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine zpttrf(N, D, E, INFO)
ZPTTRF
Definition: zpttrf.f:92