1*> \brief \b DLAPTM 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 DLAPTM( N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB ) 12* 13* .. Scalar Arguments .. 14* INTEGER LDB, LDX, N, NRHS 15* DOUBLE PRECISION ALPHA, BETA 16* .. 17* .. Array Arguments .. 18* DOUBLE PRECISION B( LDB, * ), D( * ), E( * ), X( LDX, * ) 19* .. 20* 21* 22*> \par Purpose: 23* ============= 24*> 25*> \verbatim 26*> 27*> DLAPTM 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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*> \date December 2016 113* 114*> \ingroup double_lin 115* 116* ===================================================================== 117 SUBROUTINE DLAPTM( N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB ) 118* 119* -- LAPACK test routine (version 3.7.0) -- 120* -- LAPACK is a software package provided by Univ. of Tennessee, -- 121* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 122* December 2016 123* 124* .. Scalar Arguments .. 125 INTEGER LDB, LDX, N, NRHS 126 DOUBLE PRECISION ALPHA, BETA 127* .. 128* .. Array Arguments .. 129 DOUBLE PRECISION B( LDB, * ), D( * ), E( * ), X( LDX, * ) 130* .. 131* 132* ===================================================================== 133* 134* .. Parameters .. 135 DOUBLE PRECISION ONE, ZERO 136 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 137* .. 138* .. Local Scalars .. 139 INTEGER I, J 140* .. 141* .. Executable Statements .. 142* 143 IF( N.EQ.0 ) 144 $ RETURN 145* 146* Multiply B by BETA if BETA.NE.1. 147* 148 IF( BETA.EQ.ZERO ) THEN 149 DO 20 J = 1, NRHS 150 DO 10 I = 1, N 151 B( I, J ) = ZERO 152 10 CONTINUE 153 20 CONTINUE 154 ELSE IF( BETA.EQ.-ONE ) THEN 155 DO 40 J = 1, NRHS 156 DO 30 I = 1, N 157 B( I, J ) = -B( I, J ) 158 30 CONTINUE 159 40 CONTINUE 160 END IF 161* 162 IF( ALPHA.EQ.ONE ) THEN 163* 164* Compute B := B + A*X 165* 166 DO 60 J = 1, NRHS 167 IF( N.EQ.1 ) THEN 168 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) 169 ELSE 170 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) + 171 $ E( 1 )*X( 2, J ) 172 B( N, J ) = B( N, J ) + E( N-1 )*X( N-1, J ) + 173 $ D( N )*X( N, J ) 174 DO 50 I = 2, N - 1 175 B( I, J ) = B( I, J ) + E( I-1 )*X( I-1, J ) + 176 $ D( I )*X( I, J ) + E( I )*X( I+1, J ) 177 50 CONTINUE 178 END IF 179 60 CONTINUE 180 ELSE IF( ALPHA.EQ.-ONE ) THEN 181* 182* Compute B := B - A*X 183* 184 DO 80 J = 1, NRHS 185 IF( N.EQ.1 ) THEN 186 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) 187 ELSE 188 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) - 189 $ E( 1 )*X( 2, J ) 190 B( N, J ) = B( N, J ) - E( N-1 )*X( N-1, J ) - 191 $ D( N )*X( N, J ) 192 DO 70 I = 2, N - 1 193 B( I, J ) = B( I, J ) - E( I-1 )*X( I-1, J ) - 194 $ D( I )*X( I, J ) - E( I )*X( I+1, J ) 195 70 CONTINUE 196 END IF 197 80 CONTINUE 198 END IF 199 RETURN 200* 201* End of DLAPTM 202* 203 END 204