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
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zpttrf.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack