![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZPTTRF 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download ZPTTRF + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zpttrf.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zpttrf.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zpttrf.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE ZPTTRF( N, D, E, INFO ) 00022 * 00023 * .. Scalar Arguments .. 00024 * INTEGER INFO, N 00025 * .. 00026 * .. Array Arguments .. 00027 * DOUBLE PRECISION D( * ) 00028 * COMPLEX*16 E( * ) 00029 * .. 00030 * 00031 * 00032 *> \par Purpose: 00033 * ============= 00034 *> 00035 *> \verbatim 00036 *> 00037 *> ZPTTRF computes the L*D*L**H factorization of a complex Hermitian 00038 *> positive definite tridiagonal matrix A. The factorization may also 00039 *> be regarded as having the form A = U**H *D*U. 00040 *> \endverbatim 00041 * 00042 * Arguments: 00043 * ========== 00044 * 00045 *> \param[in] N 00046 *> \verbatim 00047 *> N is INTEGER 00048 *> The order of the matrix A. N >= 0. 00049 *> \endverbatim 00050 *> 00051 *> \param[in,out] D 00052 *> \verbatim 00053 *> D is DOUBLE PRECISION array, dimension (N) 00054 *> On entry, the n diagonal elements of the tridiagonal matrix 00055 *> A. On exit, the n diagonal elements of the diagonal matrix 00056 *> D from the L*D*L**H factorization of A. 00057 *> \endverbatim 00058 *> 00059 *> \param[in,out] E 00060 *> \verbatim 00061 *> E is COMPLEX*16 array, dimension (N-1) 00062 *> On entry, the (n-1) subdiagonal elements of the tridiagonal 00063 *> matrix A. On exit, the (n-1) subdiagonal elements of the 00064 *> unit bidiagonal factor L from the L*D*L**H factorization of A. 00065 *> E can also be regarded as the superdiagonal of the unit 00066 *> bidiagonal factor U from the U**H *D*U factorization of A. 00067 *> \endverbatim 00068 *> 00069 *> \param[out] INFO 00070 *> \verbatim 00071 *> INFO is INTEGER 00072 *> = 0: successful exit 00073 *> < 0: if INFO = -k, the k-th argument had an illegal value 00074 *> > 0: if INFO = k, the leading minor of order k is not 00075 *> positive definite; if k < N, the factorization could not 00076 *> be completed, while if k = N, the factorization was 00077 *> completed, but D(N) <= 0. 00078 *> \endverbatim 00079 * 00080 * Authors: 00081 * ======== 00082 * 00083 *> \author Univ. of Tennessee 00084 *> \author Univ. of California Berkeley 00085 *> \author Univ. of Colorado Denver 00086 *> \author NAG Ltd. 00087 * 00088 *> \date November 2011 00089 * 00090 *> \ingroup complex16OTHERcomputational 00091 * 00092 * ===================================================================== 00093 SUBROUTINE ZPTTRF( N, D, E, INFO ) 00094 * 00095 * -- LAPACK computational routine (version 3.4.0) -- 00096 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00097 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00098 * November 2011 00099 * 00100 * .. Scalar Arguments .. 00101 INTEGER INFO, N 00102 * .. 00103 * .. Array Arguments .. 00104 DOUBLE PRECISION D( * ) 00105 COMPLEX*16 E( * ) 00106 * .. 00107 * 00108 * ===================================================================== 00109 * 00110 * .. Parameters .. 00111 DOUBLE PRECISION ZERO 00112 PARAMETER ( ZERO = 0.0D+0 ) 00113 * .. 00114 * .. Local Scalars .. 00115 INTEGER I, I4 00116 DOUBLE PRECISION EII, EIR, F, G 00117 * .. 00118 * .. External Subroutines .. 00119 EXTERNAL XERBLA 00120 * .. 00121 * .. Intrinsic Functions .. 00122 INTRINSIC DBLE, DCMPLX, DIMAG, MOD 00123 * .. 00124 * .. Executable Statements .. 00125 * 00126 * Test the input parameters. 00127 * 00128 INFO = 0 00129 IF( N.LT.0 ) THEN 00130 INFO = -1 00131 CALL XERBLA( 'ZPTTRF', -INFO ) 00132 RETURN 00133 END IF 00134 * 00135 * Quick return if possible 00136 * 00137 IF( N.EQ.0 ) 00138 $ RETURN 00139 * 00140 * Compute the L*D*L**H (or U**H *D*U) factorization of A. 00141 * 00142 I4 = MOD( N-1, 4 ) 00143 DO 10 I = 1, I4 00144 IF( D( I ).LE.ZERO ) THEN 00145 INFO = I 00146 GO TO 30 00147 END IF 00148 EIR = DBLE( E( I ) ) 00149 EII = DIMAG( E( I ) ) 00150 F = EIR / D( I ) 00151 G = EII / D( I ) 00152 E( I ) = DCMPLX( F, G ) 00153 D( I+1 ) = D( I+1 ) - F*EIR - G*EII 00154 10 CONTINUE 00155 * 00156 DO 20 I = I4 + 1, N - 4, 4 00157 * 00158 * Drop out of the loop if d(i) <= 0: the matrix is not positive 00159 * definite. 00160 * 00161 IF( D( I ).LE.ZERO ) THEN 00162 INFO = I 00163 GO TO 30 00164 END IF 00165 * 00166 * Solve for e(i) and d(i+1). 00167 * 00168 EIR = DBLE( E( I ) ) 00169 EII = DIMAG( E( I ) ) 00170 F = EIR / D( I ) 00171 G = EII / D( I ) 00172 E( I ) = DCMPLX( F, G ) 00173 D( I+1 ) = D( I+1 ) - F*EIR - G*EII 00174 * 00175 IF( D( I+1 ).LE.ZERO ) THEN 00176 INFO = I + 1 00177 GO TO 30 00178 END IF 00179 * 00180 * Solve for e(i+1) and d(i+2). 00181 * 00182 EIR = DBLE( E( I+1 ) ) 00183 EII = DIMAG( E( I+1 ) ) 00184 F = EIR / D( I+1 ) 00185 G = EII / D( I+1 ) 00186 E( I+1 ) = DCMPLX( F, G ) 00187 D( I+2 ) = D( I+2 ) - F*EIR - G*EII 00188 * 00189 IF( D( I+2 ).LE.ZERO ) THEN 00190 INFO = I + 2 00191 GO TO 30 00192 END IF 00193 * 00194 * Solve for e(i+2) and d(i+3). 00195 * 00196 EIR = DBLE( E( I+2 ) ) 00197 EII = DIMAG( E( I+2 ) ) 00198 F = EIR / D( I+2 ) 00199 G = EII / D( I+2 ) 00200 E( I+2 ) = DCMPLX( F, G ) 00201 D( I+3 ) = D( I+3 ) - F*EIR - G*EII 00202 * 00203 IF( D( I+3 ).LE.ZERO ) THEN 00204 INFO = I + 3 00205 GO TO 30 00206 END IF 00207 * 00208 * Solve for e(i+3) and d(i+4). 00209 * 00210 EIR = DBLE( E( I+3 ) ) 00211 EII = DIMAG( E( I+3 ) ) 00212 F = EIR / D( I+3 ) 00213 G = EII / D( I+3 ) 00214 E( I+3 ) = DCMPLX( F, G ) 00215 D( I+4 ) = D( I+4 ) - F*EIR - G*EII 00216 20 CONTINUE 00217 * 00218 * Check d(n) for positive definiteness. 00219 * 00220 IF( D( N ).LE.ZERO ) 00221 $ INFO = N 00222 * 00223 30 CONTINUE 00224 RETURN 00225 * 00226 * End of ZPTTRF 00227 * 00228 END