Annotation of rpl/lapack/lapack/zpttrf.f, revision 1.9
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>