![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZPTTS2 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download ZPTTS2 + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zptts2.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zptts2.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zptts2.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE ZPTTS2( IUPLO, N, NRHS, D, E, B, LDB ) 00022 * 00023 * .. Scalar Arguments .. 00024 * INTEGER IUPLO, LDB, N, NRHS 00025 * .. 00026 * .. Array Arguments .. 00027 * DOUBLE PRECISION D( * ) 00028 * COMPLEX*16 B( LDB, * ), E( * ) 00029 * .. 00030 * 00031 * 00032 *> \par Purpose: 00033 * ============= 00034 *> 00035 *> \verbatim 00036 *> 00037 *> ZPTTS2 solves a tridiagonal system of the form 00038 *> A * X = B 00039 *> using the factorization A = U**H *D*U or A = L*D*L**H computed by ZPTTRF. 00040 *> D is a diagonal matrix specified in the vector D, U (or L) is a unit 00041 *> bidiagonal matrix whose superdiagonal (subdiagonal) is specified in 00042 *> the vector E, and X and B are N by NRHS matrices. 00043 *> \endverbatim 00044 * 00045 * Arguments: 00046 * ========== 00047 * 00048 *> \param[in] IUPLO 00049 *> \verbatim 00050 *> IUPLO is INTEGER 00051 *> Specifies the form of the factorization and whether the 00052 *> vector E is the superdiagonal of the upper bidiagonal factor 00053 *> U or the subdiagonal of the lower bidiagonal factor L. 00054 *> = 1: A = U**H *D*U, E is the superdiagonal of U 00055 *> = 0: A = L*D*L**H, E is the subdiagonal of L 00056 *> \endverbatim 00057 *> 00058 *> \param[in] N 00059 *> \verbatim 00060 *> N is INTEGER 00061 *> The order of the tridiagonal matrix A. N >= 0. 00062 *> \endverbatim 00063 *> 00064 *> \param[in] NRHS 00065 *> \verbatim 00066 *> NRHS is INTEGER 00067 *> The number of right hand sides, i.e., the number of columns 00068 *> of the matrix B. NRHS >= 0. 00069 *> \endverbatim 00070 *> 00071 *> \param[in] D 00072 *> \verbatim 00073 *> D is DOUBLE PRECISION array, dimension (N) 00074 *> The n diagonal elements of the diagonal matrix D from the 00075 *> factorization A = U**H *D*U or A = L*D*L**H. 00076 *> \endverbatim 00077 *> 00078 *> \param[in] E 00079 *> \verbatim 00080 *> E is COMPLEX*16 array, dimension (N-1) 00081 *> If IUPLO = 1, the (n-1) superdiagonal elements of the unit 00082 *> bidiagonal factor U from the factorization A = U**H*D*U. 00083 *> If IUPLO = 0, the (n-1) subdiagonal elements of the unit 00084 *> bidiagonal factor L from the factorization A = L*D*L**H. 00085 *> \endverbatim 00086 *> 00087 *> \param[in,out] B 00088 *> \verbatim 00089 *> B is DOUBLE PRECISION array, dimension (LDB,NRHS) 00090 *> On entry, the right hand side vectors B for the system of 00091 *> linear equations. 00092 *> On exit, the solution vectors, X. 00093 *> \endverbatim 00094 *> 00095 *> \param[in] LDB 00096 *> \verbatim 00097 *> LDB is INTEGER 00098 *> The leading dimension of the array B. LDB >= max(1,N). 00099 *> \endverbatim 00100 * 00101 * Authors: 00102 * ======== 00103 * 00104 *> \author Univ. of Tennessee 00105 *> \author Univ. of California Berkeley 00106 *> \author Univ. of Colorado Denver 00107 *> \author NAG Ltd. 00108 * 00109 *> \date November 2011 00110 * 00111 *> \ingroup complex16OTHERcomputational 00112 * 00113 * ===================================================================== 00114 SUBROUTINE ZPTTS2( IUPLO, N, NRHS, D, E, B, LDB ) 00115 * 00116 * -- LAPACK computational routine (version 3.4.0) -- 00117 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00118 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00119 * November 2011 00120 * 00121 * .. Scalar Arguments .. 00122 INTEGER IUPLO, LDB, N, NRHS 00123 * .. 00124 * .. Array Arguments .. 00125 DOUBLE PRECISION D( * ) 00126 COMPLEX*16 B( LDB, * ), E( * ) 00127 * .. 00128 * 00129 * ===================================================================== 00130 * 00131 * .. Local Scalars .. 00132 INTEGER I, J 00133 * .. 00134 * .. External Subroutines .. 00135 EXTERNAL ZDSCAL 00136 * .. 00137 * .. Intrinsic Functions .. 00138 INTRINSIC DCONJG 00139 * .. 00140 * .. Executable Statements .. 00141 * 00142 * Quick return if possible 00143 * 00144 IF( N.LE.1 ) THEN 00145 IF( N.EQ.1 ) 00146 $ CALL ZDSCAL( NRHS, 1.D0 / D( 1 ), B, LDB ) 00147 RETURN 00148 END IF 00149 * 00150 IF( IUPLO.EQ.1 ) THEN 00151 * 00152 * Solve A * X = B using the factorization A = U**H *D*U, 00153 * overwriting each right hand side vector with its solution. 00154 * 00155 IF( NRHS.LE.2 ) THEN 00156 J = 1 00157 10 CONTINUE 00158 * 00159 * Solve U**H * x = b. 00160 * 00161 DO 20 I = 2, N 00162 B( I, J ) = B( I, J ) - B( I-1, J )*DCONJG( E( I-1 ) ) 00163 20 CONTINUE 00164 * 00165 * Solve D * U * x = b. 00166 * 00167 DO 30 I = 1, N 00168 B( I, J ) = B( I, J ) / D( I ) 00169 30 CONTINUE 00170 DO 40 I = N - 1, 1, -1 00171 B( I, J ) = B( I, J ) - B( I+1, J )*E( I ) 00172 40 CONTINUE 00173 IF( J.LT.NRHS ) THEN 00174 J = J + 1 00175 GO TO 10 00176 END IF 00177 ELSE 00178 DO 70 J = 1, NRHS 00179 * 00180 * Solve U**H * x = b. 00181 * 00182 DO 50 I = 2, N 00183 B( I, J ) = B( I, J ) - B( I-1, J )*DCONJG( E( I-1 ) ) 00184 50 CONTINUE 00185 * 00186 * Solve D * U * x = b. 00187 * 00188 B( N, J ) = B( N, J ) / D( N ) 00189 DO 60 I = N - 1, 1, -1 00190 B( I, J ) = B( I, J ) / D( I ) - B( I+1, J )*E( I ) 00191 60 CONTINUE 00192 70 CONTINUE 00193 END IF 00194 ELSE 00195 * 00196 * Solve A * X = B using the factorization A = L*D*L**H, 00197 * overwriting each right hand side vector with its solution. 00198 * 00199 IF( NRHS.LE.2 ) THEN 00200 J = 1 00201 80 CONTINUE 00202 * 00203 * Solve L * x = b. 00204 * 00205 DO 90 I = 2, N 00206 B( I, J ) = B( I, J ) - B( I-1, J )*E( I-1 ) 00207 90 CONTINUE 00208 * 00209 * Solve D * L**H * x = b. 00210 * 00211 DO 100 I = 1, N 00212 B( I, J ) = B( I, J ) / D( I ) 00213 100 CONTINUE 00214 DO 110 I = N - 1, 1, -1 00215 B( I, J ) = B( I, J ) - B( I+1, J )*DCONJG( E( I ) ) 00216 110 CONTINUE 00217 IF( J.LT.NRHS ) THEN 00218 J = J + 1 00219 GO TO 80 00220 END IF 00221 ELSE 00222 DO 140 J = 1, NRHS 00223 * 00224 * Solve L * x = b. 00225 * 00226 DO 120 I = 2, N 00227 B( I, J ) = B( I, J ) - B( I-1, J )*E( I-1 ) 00228 120 CONTINUE 00229 * 00230 * Solve D * L**H * x = b. 00231 * 00232 B( N, J ) = B( N, J ) / D( N ) 00233 DO 130 I = N - 1, 1, -1 00234 B( I, J ) = B( I, J ) / D( I ) - 00235 $ B( I+1, J )*DCONJG( E( I ) ) 00236 130 CONTINUE 00237 140 CONTINUE 00238 END IF 00239 END IF 00240 * 00241 RETURN 00242 * 00243 * End of ZPTTS2 00244 * 00245 END