![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DLAGTM 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download DLAGTM + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlagtm.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlagtm.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlagtm.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE DLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA, 00022 * B, LDB ) 00023 * 00024 * .. Scalar Arguments .. 00025 * CHARACTER TRANS 00026 * INTEGER LDB, LDX, N, NRHS 00027 * DOUBLE PRECISION ALPHA, BETA 00028 * .. 00029 * .. Array Arguments .. 00030 * DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ), 00031 * $ X( LDX, * ) 00032 * .. 00033 * 00034 * 00035 *> \par Purpose: 00036 * ============= 00037 *> 00038 *> \verbatim 00039 *> 00040 *> DLAGTM performs a matrix-vector product of the form 00041 *> 00042 *> B := alpha * A * X + beta * B 00043 *> 00044 *> where A is a tridiagonal matrix of order N, B and X are N by NRHS 00045 *> matrices, and alpha and beta are real scalars, each of which may be 00046 *> 0., 1., or -1. 00047 *> \endverbatim 00048 * 00049 * Arguments: 00050 * ========== 00051 * 00052 *> \param[in] TRANS 00053 *> \verbatim 00054 *> TRANS is CHARACTER*1 00055 *> Specifies the operation applied to A. 00056 *> = 'N': No transpose, B := alpha * A * X + beta * B 00057 *> = 'T': Transpose, B := alpha * A'* X + beta * B 00058 *> = 'C': Conjugate transpose = Transpose 00059 *> \endverbatim 00060 *> 00061 *> \param[in] N 00062 *> \verbatim 00063 *> N is INTEGER 00064 *> The order of the matrix A. N >= 0. 00065 *> \endverbatim 00066 *> 00067 *> \param[in] NRHS 00068 *> \verbatim 00069 *> NRHS is INTEGER 00070 *> The number of right hand sides, i.e., the number of columns 00071 *> of the matrices X and B. 00072 *> \endverbatim 00073 *> 00074 *> \param[in] ALPHA 00075 *> \verbatim 00076 *> ALPHA is DOUBLE PRECISION 00077 *> The scalar alpha. ALPHA must be 0., 1., or -1.; otherwise, 00078 *> it is assumed to be 0. 00079 *> \endverbatim 00080 *> 00081 *> \param[in] DL 00082 *> \verbatim 00083 *> DL is DOUBLE PRECISION array, dimension (N-1) 00084 *> The (n-1) sub-diagonal elements of T. 00085 *> \endverbatim 00086 *> 00087 *> \param[in] D 00088 *> \verbatim 00089 *> D is DOUBLE PRECISION array, dimension (N) 00090 *> The diagonal elements of T. 00091 *> \endverbatim 00092 *> 00093 *> \param[in] DU 00094 *> \verbatim 00095 *> DU is DOUBLE PRECISION array, dimension (N-1) 00096 *> The (n-1) super-diagonal elements of T. 00097 *> \endverbatim 00098 *> 00099 *> \param[in] X 00100 *> \verbatim 00101 *> X is DOUBLE PRECISION array, dimension (LDX,NRHS) 00102 *> The N by NRHS matrix X. 00103 *> \endverbatim 00104 *> 00105 *> \param[in] LDX 00106 *> \verbatim 00107 *> LDX is INTEGER 00108 *> The leading dimension of the array X. LDX >= max(N,1). 00109 *> \endverbatim 00110 *> 00111 *> \param[in] BETA 00112 *> \verbatim 00113 *> BETA is DOUBLE PRECISION 00114 *> The scalar beta. BETA must be 0., 1., or -1.; otherwise, 00115 *> it is assumed to be 1. 00116 *> \endverbatim 00117 *> 00118 *> \param[in,out] B 00119 *> \verbatim 00120 *> B is DOUBLE PRECISION array, dimension (LDB,NRHS) 00121 *> On entry, the N by NRHS matrix B. 00122 *> On exit, B is overwritten by the matrix expression 00123 *> B := alpha * A * X + beta * B. 00124 *> \endverbatim 00125 *> 00126 *> \param[in] LDB 00127 *> \verbatim 00128 *> LDB is INTEGER 00129 *> The leading dimension of the array B. LDB >= max(N,1). 00130 *> \endverbatim 00131 * 00132 * Authors: 00133 * ======== 00134 * 00135 *> \author Univ. of Tennessee 00136 *> \author Univ. of California Berkeley 00137 *> \author Univ. of Colorado Denver 00138 *> \author NAG Ltd. 00139 * 00140 *> \date November 2011 00141 * 00142 *> \ingroup doubleOTHERauxiliary 00143 * 00144 * ===================================================================== 00145 SUBROUTINE DLAGTM( TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA, 00146 $ B, LDB ) 00147 * 00148 * -- LAPACK auxiliary routine (version 3.4.0) -- 00149 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00150 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00151 * November 2011 00152 * 00153 * .. Scalar Arguments .. 00154 CHARACTER TRANS 00155 INTEGER LDB, LDX, N, NRHS 00156 DOUBLE PRECISION ALPHA, BETA 00157 * .. 00158 * .. Array Arguments .. 00159 DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ), 00160 $ X( LDX, * ) 00161 * .. 00162 * 00163 * ===================================================================== 00164 * 00165 * .. Parameters .. 00166 DOUBLE PRECISION ONE, ZERO 00167 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 00168 * .. 00169 * .. Local Scalars .. 00170 INTEGER I, J 00171 * .. 00172 * .. External Functions .. 00173 LOGICAL LSAME 00174 EXTERNAL LSAME 00175 * .. 00176 * .. Executable Statements .. 00177 * 00178 IF( N.EQ.0 ) 00179 $ RETURN 00180 * 00181 * Multiply B by BETA if BETA.NE.1. 00182 * 00183 IF( BETA.EQ.ZERO ) THEN 00184 DO 20 J = 1, NRHS 00185 DO 10 I = 1, N 00186 B( I, J ) = ZERO 00187 10 CONTINUE 00188 20 CONTINUE 00189 ELSE IF( BETA.EQ.-ONE ) THEN 00190 DO 40 J = 1, NRHS 00191 DO 30 I = 1, N 00192 B( I, J ) = -B( I, J ) 00193 30 CONTINUE 00194 40 CONTINUE 00195 END IF 00196 * 00197 IF( ALPHA.EQ.ONE ) THEN 00198 IF( LSAME( TRANS, 'N' ) ) THEN 00199 * 00200 * Compute B := B + A*X 00201 * 00202 DO 60 J = 1, NRHS 00203 IF( N.EQ.1 ) THEN 00204 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) 00205 ELSE 00206 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) + 00207 $ DU( 1 )*X( 2, J ) 00208 B( N, J ) = B( N, J ) + DL( N-1 )*X( N-1, J ) + 00209 $ D( N )*X( N, J ) 00210 DO 50 I = 2, N - 1 00211 B( I, J ) = B( I, J ) + DL( I-1 )*X( I-1, J ) + 00212 $ D( I )*X( I, J ) + DU( I )*X( I+1, J ) 00213 50 CONTINUE 00214 END IF 00215 60 CONTINUE 00216 ELSE 00217 * 00218 * Compute B := B + A**T*X 00219 * 00220 DO 80 J = 1, NRHS 00221 IF( N.EQ.1 ) THEN 00222 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) 00223 ELSE 00224 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) + 00225 $ DL( 1 )*X( 2, J ) 00226 B( N, J ) = B( N, J ) + DU( N-1 )*X( N-1, J ) + 00227 $ D( N )*X( N, J ) 00228 DO 70 I = 2, N - 1 00229 B( I, J ) = B( I, J ) + DU( I-1 )*X( I-1, J ) + 00230 $ D( I )*X( I, J ) + DL( I )*X( I+1, J ) 00231 70 CONTINUE 00232 END IF 00233 80 CONTINUE 00234 END IF 00235 ELSE IF( ALPHA.EQ.-ONE ) THEN 00236 IF( LSAME( TRANS, 'N' ) ) THEN 00237 * 00238 * Compute B := B - A*X 00239 * 00240 DO 100 J = 1, NRHS 00241 IF( N.EQ.1 ) THEN 00242 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) 00243 ELSE 00244 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) - 00245 $ DU( 1 )*X( 2, J ) 00246 B( N, J ) = B( N, J ) - DL( N-1 )*X( N-1, J ) - 00247 $ D( N )*X( N, J ) 00248 DO 90 I = 2, N - 1 00249 B( I, J ) = B( I, J ) - DL( I-1 )*X( I-1, J ) - 00250 $ D( I )*X( I, J ) - DU( I )*X( I+1, J ) 00251 90 CONTINUE 00252 END IF 00253 100 CONTINUE 00254 ELSE 00255 * 00256 * Compute B := B - A**T*X 00257 * 00258 DO 120 J = 1, NRHS 00259 IF( N.EQ.1 ) THEN 00260 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) 00261 ELSE 00262 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) - 00263 $ DL( 1 )*X( 2, J ) 00264 B( N, J ) = B( N, J ) - DU( N-1 )*X( N-1, J ) - 00265 $ D( N )*X( N, J ) 00266 DO 110 I = 2, N - 1 00267 B( I, J ) = B( I, J ) - DU( I-1 )*X( I-1, J ) - 00268 $ D( I )*X( I, J ) - DL( I )*X( I+1, J ) 00269 110 CONTINUE 00270 END IF 00271 120 CONTINUE 00272 END IF 00273 END IF 00274 RETURN 00275 * 00276 * End of DLAGTM 00277 * 00278 END