![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZGTSV 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download ZGTSV + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgtsv.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgtsv.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgtsv.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE ZGTSV( N, NRHS, DL, D, DU, B, LDB, INFO ) 00022 * 00023 * .. Scalar Arguments .. 00024 * INTEGER INFO, LDB, N, NRHS 00025 * .. 00026 * .. Array Arguments .. 00027 * COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ) 00028 * .. 00029 * 00030 * 00031 *> \par Purpose: 00032 * ============= 00033 *> 00034 *> \verbatim 00035 *> 00036 *> ZGTSV solves the equation 00037 *> 00038 *> A*X = B, 00039 *> 00040 *> where A is an N-by-N tridiagonal matrix, by Gaussian elimination with 00041 *> partial pivoting. 00042 *> 00043 *> Note that the equation A**T *X = B may be solved by interchanging the 00044 *> order of the arguments DU and DL. 00045 *> \endverbatim 00046 * 00047 * Arguments: 00048 * ========== 00049 * 00050 *> \param[in] N 00051 *> \verbatim 00052 *> N is INTEGER 00053 *> The order of the matrix A. N >= 0. 00054 *> \endverbatim 00055 *> 00056 *> \param[in] NRHS 00057 *> \verbatim 00058 *> NRHS is INTEGER 00059 *> The number of right hand sides, i.e., the number of columns 00060 *> of the matrix B. NRHS >= 0. 00061 *> \endverbatim 00062 *> 00063 *> \param[in,out] DL 00064 *> \verbatim 00065 *> DL is COMPLEX*16 array, dimension (N-1) 00066 *> On entry, DL must contain the (n-1) subdiagonal elements of 00067 *> A. 00068 *> On exit, DL is overwritten by the (n-2) elements of the 00069 *> second superdiagonal of the upper triangular matrix U from 00070 *> the LU factorization of A, in DL(1), ..., DL(n-2). 00071 *> \endverbatim 00072 *> 00073 *> \param[in,out] D 00074 *> \verbatim 00075 *> D is COMPLEX*16 array, dimension (N) 00076 *> On entry, D must contain the diagonal elements of A. 00077 *> On exit, D is overwritten by the n diagonal elements of U. 00078 *> \endverbatim 00079 *> 00080 *> \param[in,out] DU 00081 *> \verbatim 00082 *> DU is COMPLEX*16 array, dimension (N-1) 00083 *> On entry, DU must contain the (n-1) superdiagonal elements 00084 *> of A. 00085 *> On exit, DU is overwritten by the (n-1) elements of the first 00086 *> superdiagonal of U. 00087 *> \endverbatim 00088 *> 00089 *> \param[in,out] B 00090 *> \verbatim 00091 *> B is COMPLEX*16 array, dimension (LDB,NRHS) 00092 *> On entry, the N-by-NRHS right hand side matrix B. 00093 *> On exit, if INFO = 0, the N-by-NRHS solution matrix X. 00094 *> \endverbatim 00095 *> 00096 *> \param[in] LDB 00097 *> \verbatim 00098 *> LDB is INTEGER 00099 *> The leading dimension of the array B. LDB >= max(1,N). 00100 *> \endverbatim 00101 *> 00102 *> \param[out] INFO 00103 *> \verbatim 00104 *> INFO is INTEGER 00105 *> = 0: successful exit 00106 *> < 0: if INFO = -i, the i-th argument had an illegal value 00107 *> > 0: if INFO = i, U(i,i) is exactly zero, and the solution 00108 *> has not been computed. The factorization has not been 00109 *> completed unless i = N. 00110 *> \endverbatim 00111 * 00112 * Authors: 00113 * ======== 00114 * 00115 *> \author Univ. of Tennessee 00116 *> \author Univ. of California Berkeley 00117 *> \author Univ. of Colorado Denver 00118 *> \author NAG Ltd. 00119 * 00120 *> \date November 2011 00121 * 00122 *> \ingroup complex16OTHERcomputational 00123 * 00124 * ===================================================================== 00125 SUBROUTINE ZGTSV( N, NRHS, DL, D, DU, B, LDB, INFO ) 00126 * 00127 * -- LAPACK computational routine (version 3.4.0) -- 00128 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00129 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00130 * November 2011 00131 * 00132 * .. Scalar Arguments .. 00133 INTEGER INFO, LDB, N, NRHS 00134 * .. 00135 * .. Array Arguments .. 00136 COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ) 00137 * .. 00138 * 00139 * ===================================================================== 00140 * 00141 * .. Parameters .. 00142 COMPLEX*16 ZERO 00143 PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) ) 00144 * .. 00145 * .. Local Scalars .. 00146 INTEGER J, K 00147 COMPLEX*16 MULT, TEMP, ZDUM 00148 * .. 00149 * .. Intrinsic Functions .. 00150 INTRINSIC ABS, DBLE, DIMAG, MAX 00151 * .. 00152 * .. External Subroutines .. 00153 EXTERNAL XERBLA 00154 * .. 00155 * .. Statement Functions .. 00156 DOUBLE PRECISION CABS1 00157 * .. 00158 * .. Statement Function definitions .. 00159 CABS1( ZDUM ) = ABS( DBLE( ZDUM ) ) + ABS( DIMAG( ZDUM ) ) 00160 * .. 00161 * .. Executable Statements .. 00162 * 00163 INFO = 0 00164 IF( N.LT.0 ) THEN 00165 INFO = -1 00166 ELSE IF( NRHS.LT.0 ) THEN 00167 INFO = -2 00168 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 00169 INFO = -7 00170 END IF 00171 IF( INFO.NE.0 ) THEN 00172 CALL XERBLA( 'ZGTSV ', -INFO ) 00173 RETURN 00174 END IF 00175 * 00176 IF( N.EQ.0 ) 00177 $ RETURN 00178 * 00179 DO 30 K = 1, N - 1 00180 IF( DL( K ).EQ.ZERO ) THEN 00181 * 00182 * Subdiagonal is zero, no elimination is required. 00183 * 00184 IF( D( K ).EQ.ZERO ) THEN 00185 * 00186 * Diagonal is zero: set INFO = K and return; a unique 00187 * solution can not be found. 00188 * 00189 INFO = K 00190 RETURN 00191 END IF 00192 ELSE IF( CABS1( D( K ) ).GE.CABS1( DL( K ) ) ) THEN 00193 * 00194 * No row interchange required 00195 * 00196 MULT = DL( K ) / D( K ) 00197 D( K+1 ) = D( K+1 ) - MULT*DU( K ) 00198 DO 10 J = 1, NRHS 00199 B( K+1, J ) = B( K+1, J ) - MULT*B( K, J ) 00200 10 CONTINUE 00201 IF( K.LT.( N-1 ) ) 00202 $ DL( K ) = ZERO 00203 ELSE 00204 * 00205 * Interchange rows K and K+1 00206 * 00207 MULT = D( K ) / DL( K ) 00208 D( K ) = DL( K ) 00209 TEMP = D( K+1 ) 00210 D( K+1 ) = DU( K ) - MULT*TEMP 00211 IF( K.LT.( N-1 ) ) THEN 00212 DL( K ) = DU( K+1 ) 00213 DU( K+1 ) = -MULT*DL( K ) 00214 END IF 00215 DU( K ) = TEMP 00216 DO 20 J = 1, NRHS 00217 TEMP = B( K, J ) 00218 B( K, J ) = B( K+1, J ) 00219 B( K+1, J ) = TEMP - MULT*B( K+1, J ) 00220 20 CONTINUE 00221 END IF 00222 30 CONTINUE 00223 IF( D( N ).EQ.ZERO ) THEN 00224 INFO = N 00225 RETURN 00226 END IF 00227 * 00228 * Back solve with the matrix U from the factorization. 00229 * 00230 DO 50 J = 1, NRHS 00231 B( N, J ) = B( N, J ) / D( N ) 00232 IF( N.GT.1 ) 00233 $ B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) / D( N-1 ) 00234 DO 40 K = N - 2, 1, -1 00235 B( K, J ) = ( B( K, J )-DU( K )*B( K+1, J )-DL( K )* 00236 $ B( K+2, J ) ) / D( K ) 00237 40 CONTINUE 00238 50 CONTINUE 00239 * 00240 RETURN 00241 * 00242 * End of ZGTSV 00243 * 00244 END