1*> \brief \b SLAPTM 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE SLAPTM( N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB ) 12* 13* .. Scalar Arguments .. 14* INTEGER LDB, LDX, N, NRHS 15* REAL ALPHA, BETA 16* .. 17* .. Array Arguments .. 18* REAL B( LDB, * ), D( * ), E( * ), X( LDX, * ) 19* .. 20* 21* 22*> \par Purpose: 23* ============= 24*> 25*> \verbatim 26*> 27*> SLAPTM multiplies an N by NRHS matrix X by a symmetric tridiagonal 28*> matrix A and stores the result in a matrix B. The operation has the 29*> form 30*> 31*> B := alpha * A * X + beta * B 32*> 33*> where alpha may be either 1. or -1. and beta may be 0., 1., or -1. 34*> \endverbatim 35* 36* Arguments: 37* ========== 38* 39*> \param[in] N 40*> \verbatim 41*> N is INTEGER 42*> The order of the matrix A. N >= 0. 43*> \endverbatim 44*> 45*> \param[in] NRHS 46*> \verbatim 47*> NRHS is INTEGER 48*> The number of right hand sides, i.e., the number of columns 49*> of the matrices X and B. 50*> \endverbatim 51*> 52*> \param[in] ALPHA 53*> \verbatim 54*> ALPHA is REAL 55*> The scalar alpha. ALPHA must be 1. or -1.; otherwise, 56*> it is assumed to be 0. 57*> \endverbatim 58*> 59*> \param[in] D 60*> \verbatim 61*> D is REAL array, dimension (N) 62*> The n diagonal elements of the tridiagonal matrix A. 63*> \endverbatim 64*> 65*> \param[in] E 66*> \verbatim 67*> E is REAL array, dimension (N-1) 68*> The (n-1) subdiagonal or superdiagonal elements of A. 69*> \endverbatim 70*> 71*> \param[in] X 72*> \verbatim 73*> X is REAL array, dimension (LDX,NRHS) 74*> The N by NRHS matrix X. 75*> \endverbatim 76*> 77*> \param[in] LDX 78*> \verbatim 79*> LDX is INTEGER 80*> The leading dimension of the array X. LDX >= max(N,1). 81*> \endverbatim 82*> 83*> \param[in] BETA 84*> \verbatim 85*> BETA is REAL 86*> The scalar beta. BETA must be 0., 1., or -1.; otherwise, 87*> it is assumed to be 1. 88*> \endverbatim 89*> 90*> \param[in,out] B 91*> \verbatim 92*> B is REAL array, dimension (LDB,NRHS) 93*> On entry, the N by NRHS matrix B. 94*> On exit, B is overwritten by the matrix expression 95*> B := alpha * A * X + beta * B. 96*> \endverbatim 97*> 98*> \param[in] LDB 99*> \verbatim 100*> LDB is INTEGER 101*> The leading dimension of the array B. LDB >= max(N,1). 102*> \endverbatim 103* 104* Authors: 105* ======== 106* 107*> \author Univ. of Tennessee 108*> \author Univ. of California Berkeley 109*> \author Univ. of Colorado Denver 110*> \author NAG Ltd. 111* 112*> \ingroup single_lin 113* 114* ===================================================================== 115 SUBROUTINE SLAPTM( N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB ) 116* 117* -- LAPACK test routine -- 118* -- LAPACK is a software package provided by Univ. of Tennessee, -- 119* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 120* 121* .. Scalar Arguments .. 122 INTEGER LDB, LDX, N, NRHS 123 REAL ALPHA, BETA 124* .. 125* .. Array Arguments .. 126 REAL B( LDB, * ), D( * ), E( * ), X( LDX, * ) 127* .. 128* 129* ===================================================================== 130* 131* .. Parameters .. 132 REAL ONE, ZERO 133 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 134* .. 135* .. Local Scalars .. 136 INTEGER I, J 137* .. 138* .. Executable Statements .. 139* 140 IF( N.EQ.0 ) 141 $ RETURN 142* 143* Multiply B by BETA if BETA.NE.1. 144* 145 IF( BETA.EQ.ZERO ) THEN 146 DO 20 J = 1, NRHS 147 DO 10 I = 1, N 148 B( I, J ) = ZERO 149 10 CONTINUE 150 20 CONTINUE 151 ELSE IF( BETA.EQ.-ONE ) THEN 152 DO 40 J = 1, NRHS 153 DO 30 I = 1, N 154 B( I, J ) = -B( I, J ) 155 30 CONTINUE 156 40 CONTINUE 157 END IF 158* 159 IF( ALPHA.EQ.ONE ) THEN 160* 161* Compute B := B + A*X 162* 163 DO 60 J = 1, NRHS 164 IF( N.EQ.1 ) THEN 165 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) 166 ELSE 167 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) + 168 $ E( 1 )*X( 2, J ) 169 B( N, J ) = B( N, J ) + E( N-1 )*X( N-1, J ) + 170 $ D( N )*X( N, J ) 171 DO 50 I = 2, N - 1 172 B( I, J ) = B( I, J ) + E( I-1 )*X( I-1, J ) + 173 $ D( I )*X( I, J ) + E( I )*X( I+1, J ) 174 50 CONTINUE 175 END IF 176 60 CONTINUE 177 ELSE IF( ALPHA.EQ.-ONE ) THEN 178* 179* Compute B := B - A*X 180* 181 DO 80 J = 1, NRHS 182 IF( N.EQ.1 ) THEN 183 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) 184 ELSE 185 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) - 186 $ E( 1 )*X( 2, J ) 187 B( N, J ) = B( N, J ) - E( N-1 )*X( N-1, J ) - 188 $ D( N )*X( N, J ) 189 DO 70 I = 2, N - 1 190 B( I, J ) = B( I, J ) - E( I-1 )*X( I-1, J ) - 191 $ D( I )*X( I, J ) - E( I )*X( I+1, J ) 192 70 CONTINUE 193 END IF 194 80 CONTINUE 195 END IF 196 RETURN 197* 198* End of SLAPTM 199* 200 END 201