![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SLAPTM 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE SLAPTM( N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB ) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER LDB, LDX, N, NRHS 00015 * REAL ALPHA, BETA 00016 * .. 00017 * .. Array Arguments .. 00018 * REAL B( LDB, * ), D( * ), E( * ), X( LDX, * ) 00019 * .. 00020 * 00021 * 00022 *> \par Purpose: 00023 * ============= 00024 *> 00025 *> \verbatim 00026 *> 00027 *> SLAPTM multiplies an N by NRHS matrix X by a symmetric tridiagonal 00028 *> matrix A and stores the result in a matrix B. The operation has the 00029 *> form 00030 *> 00031 *> B := alpha * A * X + beta * B 00032 *> 00033 *> where alpha may be either 1. or -1. and beta may be 0., 1., or -1. 00034 *> \endverbatim 00035 * 00036 * Arguments: 00037 * ========== 00038 * 00039 *> \param[in] N 00040 *> \verbatim 00041 *> N is INTEGER 00042 *> The order of the matrix A. N >= 0. 00043 *> \endverbatim 00044 *> 00045 *> \param[in] NRHS 00046 *> \verbatim 00047 *> NRHS is INTEGER 00048 *> The number of right hand sides, i.e., the number of columns 00049 *> of the matrices X and B. 00050 *> \endverbatim 00051 *> 00052 *> \param[in] ALPHA 00053 *> \verbatim 00054 *> ALPHA is REAL 00055 *> The scalar alpha. ALPHA must be 1. or -1.; otherwise, 00056 *> it is assumed to be 0. 00057 *> \endverbatim 00058 *> 00059 *> \param[in] D 00060 *> \verbatim 00061 *> D is REAL array, dimension (N) 00062 *> The n diagonal elements of the tridiagonal matrix A. 00063 *> \endverbatim 00064 *> 00065 *> \param[in] E 00066 *> \verbatim 00067 *> E is REAL array, dimension (N-1) 00068 *> The (n-1) subdiagonal or superdiagonal elements of A. 00069 *> \endverbatim 00070 *> 00071 *> \param[in] X 00072 *> \verbatim 00073 *> X is REAL array, dimension (LDX,NRHS) 00074 *> The N by NRHS matrix X. 00075 *> \endverbatim 00076 *> 00077 *> \param[in] LDX 00078 *> \verbatim 00079 *> LDX is INTEGER 00080 *> The leading dimension of the array X. LDX >= max(N,1). 00081 *> \endverbatim 00082 *> 00083 *> \param[in] BETA 00084 *> \verbatim 00085 *> BETA is REAL 00086 *> The scalar beta. BETA must be 0., 1., or -1.; otherwise, 00087 *> it is assumed to be 1. 00088 *> \endverbatim 00089 *> 00090 *> \param[in,out] B 00091 *> \verbatim 00092 *> B is REAL array, dimension (LDB,NRHS) 00093 *> On entry, the N by NRHS matrix B. 00094 *> On exit, B is overwritten by the matrix expression 00095 *> B := alpha * A * X + beta * B. 00096 *> \endverbatim 00097 *> 00098 *> \param[in] LDB 00099 *> \verbatim 00100 *> LDB is INTEGER 00101 *> The leading dimension of the array B. LDB >= max(N,1). 00102 *> \endverbatim 00103 * 00104 * Authors: 00105 * ======== 00106 * 00107 *> \author Univ. of Tennessee 00108 *> \author Univ. of California Berkeley 00109 *> \author Univ. of Colorado Denver 00110 *> \author NAG Ltd. 00111 * 00112 *> \date November 2011 00113 * 00114 *> \ingroup single_lin 00115 * 00116 * ===================================================================== 00117 SUBROUTINE SLAPTM( N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB ) 00118 * 00119 * -- LAPACK test routine (version 3.4.0) -- 00120 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00121 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00122 * November 2011 00123 * 00124 * .. Scalar Arguments .. 00125 INTEGER LDB, LDX, N, NRHS 00126 REAL ALPHA, BETA 00127 * .. 00128 * .. Array Arguments .. 00129 REAL B( LDB, * ), D( * ), E( * ), X( LDX, * ) 00130 * .. 00131 * 00132 * ===================================================================== 00133 * 00134 * .. Parameters .. 00135 REAL ONE, ZERO 00136 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00137 * .. 00138 * .. Local Scalars .. 00139 INTEGER I, J 00140 * .. 00141 * .. Executable Statements .. 00142 * 00143 IF( N.EQ.0 ) 00144 $ RETURN 00145 * 00146 * Multiply B by BETA if BETA.NE.1. 00147 * 00148 IF( BETA.EQ.ZERO ) THEN 00149 DO 20 J = 1, NRHS 00150 DO 10 I = 1, N 00151 B( I, J ) = ZERO 00152 10 CONTINUE 00153 20 CONTINUE 00154 ELSE IF( BETA.EQ.-ONE ) THEN 00155 DO 40 J = 1, NRHS 00156 DO 30 I = 1, N 00157 B( I, J ) = -B( I, J ) 00158 30 CONTINUE 00159 40 CONTINUE 00160 END IF 00161 * 00162 IF( ALPHA.EQ.ONE ) THEN 00163 * 00164 * Compute B := B + A*X 00165 * 00166 DO 60 J = 1, NRHS 00167 IF( N.EQ.1 ) THEN 00168 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) 00169 ELSE 00170 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) + 00171 $ E( 1 )*X( 2, J ) 00172 B( N, J ) = B( N, J ) + E( N-1 )*X( N-1, J ) + 00173 $ D( N )*X( N, J ) 00174 DO 50 I = 2, N - 1 00175 B( I, J ) = B( I, J ) + E( I-1 )*X( I-1, J ) + 00176 $ D( I )*X( I, J ) + E( I )*X( I+1, J ) 00177 50 CONTINUE 00178 END IF 00179 60 CONTINUE 00180 ELSE IF( ALPHA.EQ.-ONE ) THEN 00181 * 00182 * Compute B := B - A*X 00183 * 00184 DO 80 J = 1, NRHS 00185 IF( N.EQ.1 ) THEN 00186 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) 00187 ELSE 00188 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) - 00189 $ E( 1 )*X( 2, J ) 00190 B( N, J ) = B( N, J ) - E( N-1 )*X( N-1, J ) - 00191 $ D( N )*X( N, J ) 00192 DO 70 I = 2, N - 1 00193 B( I, J ) = B( I, J ) - E( I-1 )*X( I-1, J ) - 00194 $ D( I )*X( I, J ) - E( I )*X( I+1, J ) 00195 70 CONTINUE 00196 END IF 00197 80 CONTINUE 00198 END IF 00199 RETURN 00200 * 00201 * End of SLAPTM 00202 * 00203 END