Annotation of rpl/lapack/lapack/zpttrf.f, revision 1.10
1.9 bertrand 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: *> \date November 2011
89: *
90: *> \ingroup complex16OTHERcomputational
91: *
92: * =====================================================================
1.1 bertrand 93: SUBROUTINE ZPTTRF( N, D, E, INFO )
94: *
1.9 bertrand 95: * -- LAPACK computational routine (version 3.4.0) --
1.1 bertrand 96: * -- LAPACK is a software package provided by Univ. of Tennessee, --
97: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.9 bertrand 98: * November 2011
1.1 bertrand 99: *
100: * .. Scalar Arguments ..
101: INTEGER INFO, N
102: * ..
103: * .. Array Arguments ..
104: DOUBLE PRECISION D( * )
105: COMPLEX*16 E( * )
106: * ..
107: *
108: * =====================================================================
109: *
110: * .. Parameters ..
111: DOUBLE PRECISION ZERO
112: PARAMETER ( ZERO = 0.0D+0 )
113: * ..
114: * .. Local Scalars ..
115: INTEGER I, I4
116: DOUBLE PRECISION EII, EIR, F, G
117: * ..
118: * .. External Subroutines ..
119: EXTERNAL XERBLA
120: * ..
121: * .. Intrinsic Functions ..
122: INTRINSIC DBLE, DCMPLX, DIMAG, MOD
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( 'ZPTTRF', -INFO )
132: RETURN
133: END IF
134: *
135: * Quick return if possible
136: *
137: IF( N.EQ.0 )
138: $ RETURN
139: *
1.8 bertrand 140: * Compute the L*D*L**H (or U**H *D*U) factorization of A.
1.1 bertrand 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 30
147: END IF
148: EIR = DBLE( E( I ) )
149: EII = DIMAG( E( I ) )
150: F = EIR / D( I )
151: G = EII / D( I )
152: E( I ) = DCMPLX( F, G )
153: D( I+1 ) = D( I+1 ) - F*EIR - G*EII
154: 10 CONTINUE
155: *
156: DO 20 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 30
164: END IF
165: *
166: * Solve for e(i) and d(i+1).
167: *
168: EIR = DBLE( E( I ) )
169: EII = DIMAG( E( I ) )
170: F = EIR / D( I )
171: G = EII / D( I )
172: E( I ) = DCMPLX( 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 30
178: END IF
179: *
180: * Solve for e(i+1) and d(i+2).
181: *
182: EIR = DBLE( E( I+1 ) )
183: EII = DIMAG( E( I+1 ) )
184: F = EIR / D( I+1 )
185: G = EII / D( I+1 )
186: E( I+1 ) = DCMPLX( 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 30
192: END IF
193: *
194: * Solve for e(i+2) and d(i+3).
195: *
196: EIR = DBLE( E( I+2 ) )
197: EII = DIMAG( E( I+2 ) )
198: F = EIR / D( I+2 )
199: G = EII / D( I+2 )
200: E( I+2 ) = DCMPLX( 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 30
206: END IF
207: *
208: * Solve for e(i+3) and d(i+4).
209: *
210: EIR = DBLE( E( I+3 ) )
211: EII = DIMAG( E( I+3 ) )
212: F = EIR / D( I+3 )
213: G = EII / D( I+3 )
214: E( I+3 ) = DCMPLX( F, G )
215: D( I+4 ) = D( I+4 ) - F*EIR - G*EII
216: 20 CONTINUE
217: *
218: * Check d(n) for positive definiteness.
219: *
220: IF( D( N ).LE.ZERO )
221: $ INFO = N
222: *
223: 30 CONTINUE
224: RETURN
225: *
226: * End of ZPTTRF
227: *
228: 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