![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CLAGTM 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download CLAGTM + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clagtm.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clagtm.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clagtm.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE CLAGTM( 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 * REAL ALPHA, BETA 00028 * .. 00029 * .. Array Arguments .. 00030 * COMPLEX B( LDB, * ), D( * ), DL( * ), DU( * ), 00031 * $ X( LDX, * ) 00032 * .. 00033 * 00034 * 00035 *> \par Purpose: 00036 * ============= 00037 *> 00038 *> \verbatim 00039 *> 00040 *> CLAGTM 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**T * X + beta * B 00058 *> = 'C': Conjugate transpose, B := alpha * A**H * X + beta * B 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 REAL 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 COMPLEX 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 COMPLEX array, dimension (N) 00090 *> The diagonal elements of T. 00091 *> \endverbatim 00092 *> 00093 *> \param[in] DU 00094 *> \verbatim 00095 *> DU is COMPLEX 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 COMPLEX 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 REAL 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 COMPLEX 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 complexOTHERauxiliary 00143 * 00144 * ===================================================================== 00145 SUBROUTINE CLAGTM( 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 REAL ALPHA, BETA 00157 * .. 00158 * .. Array Arguments .. 00159 COMPLEX B( LDB, * ), D( * ), DL( * ), DU( * ), 00160 $ X( LDX, * ) 00161 * .. 00162 * 00163 * ===================================================================== 00164 * 00165 * .. Parameters .. 00166 REAL ONE, ZERO 00167 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00168 * .. 00169 * .. Local Scalars .. 00170 INTEGER I, J 00171 * .. 00172 * .. External Functions .. 00173 LOGICAL LSAME 00174 EXTERNAL LSAME 00175 * .. 00176 * .. Intrinsic Functions .. 00177 INTRINSIC CONJG 00178 * .. 00179 * .. Executable Statements .. 00180 * 00181 IF( N.EQ.0 ) 00182 $ RETURN 00183 * 00184 * Multiply B by BETA if BETA.NE.1. 00185 * 00186 IF( BETA.EQ.ZERO ) THEN 00187 DO 20 J = 1, NRHS 00188 DO 10 I = 1, N 00189 B( I, J ) = ZERO 00190 10 CONTINUE 00191 20 CONTINUE 00192 ELSE IF( BETA.EQ.-ONE ) THEN 00193 DO 40 J = 1, NRHS 00194 DO 30 I = 1, N 00195 B( I, J ) = -B( I, J ) 00196 30 CONTINUE 00197 40 CONTINUE 00198 END IF 00199 * 00200 IF( ALPHA.EQ.ONE ) THEN 00201 IF( LSAME( TRANS, 'N' ) ) THEN 00202 * 00203 * Compute B := B + A*X 00204 * 00205 DO 60 J = 1, NRHS 00206 IF( N.EQ.1 ) THEN 00207 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) 00208 ELSE 00209 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) + 00210 $ DU( 1 )*X( 2, J ) 00211 B( N, J ) = B( N, J ) + DL( N-1 )*X( N-1, J ) + 00212 $ D( N )*X( N, J ) 00213 DO 50 I = 2, N - 1 00214 B( I, J ) = B( I, J ) + DL( I-1 )*X( I-1, J ) + 00215 $ D( I )*X( I, J ) + DU( I )*X( I+1, J ) 00216 50 CONTINUE 00217 END IF 00218 60 CONTINUE 00219 ELSE IF( LSAME( TRANS, 'T' ) ) THEN 00220 * 00221 * Compute B := B + A**T * X 00222 * 00223 DO 80 J = 1, NRHS 00224 IF( N.EQ.1 ) THEN 00225 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) 00226 ELSE 00227 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) + 00228 $ DL( 1 )*X( 2, J ) 00229 B( N, J ) = B( N, J ) + DU( N-1 )*X( N-1, J ) + 00230 $ D( N )*X( N, J ) 00231 DO 70 I = 2, N - 1 00232 B( I, J ) = B( I, J ) + DU( I-1 )*X( I-1, J ) + 00233 $ D( I )*X( I, J ) + DL( I )*X( I+1, J ) 00234 70 CONTINUE 00235 END IF 00236 80 CONTINUE 00237 ELSE IF( LSAME( TRANS, 'C' ) ) THEN 00238 * 00239 * Compute B := B + A**H * X 00240 * 00241 DO 100 J = 1, NRHS 00242 IF( N.EQ.1 ) THEN 00243 B( 1, J ) = B( 1, J ) + CONJG( D( 1 ) )*X( 1, J ) 00244 ELSE 00245 B( 1, J ) = B( 1, J ) + CONJG( D( 1 ) )*X( 1, J ) + 00246 $ CONJG( DL( 1 ) )*X( 2, J ) 00247 B( N, J ) = B( N, J ) + CONJG( DU( N-1 ) )* 00248 $ X( N-1, J ) + CONJG( D( N ) )*X( N, J ) 00249 DO 90 I = 2, N - 1 00250 B( I, J ) = B( I, J ) + CONJG( DU( I-1 ) )* 00251 $ X( I-1, J ) + CONJG( D( I ) )* 00252 $ X( I, J ) + CONJG( DL( I ) )* 00253 $ X( I+1, J ) 00254 90 CONTINUE 00255 END IF 00256 100 CONTINUE 00257 END IF 00258 ELSE IF( ALPHA.EQ.-ONE ) THEN 00259 IF( LSAME( TRANS, 'N' ) ) THEN 00260 * 00261 * Compute B := B - A*X 00262 * 00263 DO 120 J = 1, NRHS 00264 IF( N.EQ.1 ) THEN 00265 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) 00266 ELSE 00267 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) - 00268 $ DU( 1 )*X( 2, J ) 00269 B( N, J ) = B( N, J ) - DL( N-1 )*X( N-1, J ) - 00270 $ D( N )*X( N, J ) 00271 DO 110 I = 2, N - 1 00272 B( I, J ) = B( I, J ) - DL( I-1 )*X( I-1, J ) - 00273 $ D( I )*X( I, J ) - DU( I )*X( I+1, J ) 00274 110 CONTINUE 00275 END IF 00276 120 CONTINUE 00277 ELSE IF( LSAME( TRANS, 'T' ) ) THEN 00278 * 00279 * Compute B := B - A**T*X 00280 * 00281 DO 140 J = 1, NRHS 00282 IF( N.EQ.1 ) THEN 00283 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) 00284 ELSE 00285 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) - 00286 $ DL( 1 )*X( 2, J ) 00287 B( N, J ) = B( N, J ) - DU( N-1 )*X( N-1, J ) - 00288 $ D( N )*X( N, J ) 00289 DO 130 I = 2, N - 1 00290 B( I, J ) = B( I, J ) - DU( I-1 )*X( I-1, J ) - 00291 $ D( I )*X( I, J ) - DL( I )*X( I+1, J ) 00292 130 CONTINUE 00293 END IF 00294 140 CONTINUE 00295 ELSE IF( LSAME( TRANS, 'C' ) ) THEN 00296 * 00297 * Compute B := B - A**H*X 00298 * 00299 DO 160 J = 1, NRHS 00300 IF( N.EQ.1 ) THEN 00301 B( 1, J ) = B( 1, J ) - CONJG( D( 1 ) )*X( 1, J ) 00302 ELSE 00303 B( 1, J ) = B( 1, J ) - CONJG( D( 1 ) )*X( 1, J ) - 00304 $ CONJG( DL( 1 ) )*X( 2, J ) 00305 B( N, J ) = B( N, J ) - CONJG( DU( N-1 ) )* 00306 $ X( N-1, J ) - CONJG( D( N ) )*X( N, J ) 00307 DO 150 I = 2, N - 1 00308 B( I, J ) = B( I, J ) - CONJG( DU( I-1 ) )* 00309 $ X( I-1, J ) - CONJG( D( I ) )* 00310 $ X( I, J ) - CONJG( DL( I ) )* 00311 $ X( I+1, J ) 00312 150 CONTINUE 00313 END IF 00314 160 CONTINUE 00315 END IF 00316 END IF 00317 RETURN 00318 * 00319 * End of CLAGTM 00320 * 00321 END