1*> \brief \b CLAPTM 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 CLAPTM( UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B, 12* LDB ) 13* 14* .. Scalar Arguments .. 15* CHARACTER UPLO 16* INTEGER LDB, LDX, N, NRHS 17* REAL ALPHA, BETA 18* .. 19* .. Array Arguments .. 20* REAL D( * ) 21* COMPLEX B( LDB, * ), E( * ), X( LDX, * ) 22* .. 23* 24* 25*> \par Purpose: 26* ============= 27*> 28*> \verbatim 29*> 30*> CLAPTM multiplies an N by NRHS matrix X by a Hermitian tridiagonal 31*> matrix A and stores the result in a matrix B. The operation has the 32*> form 33*> 34*> B := alpha * A * X + beta * B 35*> 36*> where alpha may be either 1. or -1. and beta may be 0., 1., or -1. 37*> \endverbatim 38* 39* Arguments: 40* ========== 41* 42*> \param[in] UPLO 43*> \verbatim 44*> UPLO is CHARACTER 45*> Specifies whether the superdiagonal or the subdiagonal of the 46*> tridiagonal matrix A is stored. 47*> = 'U': Upper, E is the superdiagonal of A. 48*> = 'L': Lower, E is the subdiagonal of A. 49*> \endverbatim 50*> 51*> \param[in] N 52*> \verbatim 53*> N is INTEGER 54*> The order of the matrix A. N >= 0. 55*> \endverbatim 56*> 57*> \param[in] NRHS 58*> \verbatim 59*> NRHS is INTEGER 60*> The number of right hand sides, i.e., the number of columns 61*> of the matrices X and B. 62*> \endverbatim 63*> 64*> \param[in] ALPHA 65*> \verbatim 66*> ALPHA is REAL 67*> The scalar alpha. ALPHA must be 1. or -1.; otherwise, 68*> it is assumed to be 0. 69*> \endverbatim 70*> 71*> \param[in] D 72*> \verbatim 73*> D is REAL array, dimension (N) 74*> The n diagonal elements of the tridiagonal matrix A. 75*> \endverbatim 76*> 77*> \param[in] E 78*> \verbatim 79*> E is COMPLEX array, dimension (N-1) 80*> The (n-1) subdiagonal or superdiagonal elements of A. 81*> \endverbatim 82*> 83*> \param[in] X 84*> \verbatim 85*> X is COMPLEX array, dimension (LDX,NRHS) 86*> The N by NRHS matrix X. 87*> \endverbatim 88*> 89*> \param[in] LDX 90*> \verbatim 91*> LDX is INTEGER 92*> The leading dimension of the array X. LDX >= max(N,1). 93*> \endverbatim 94*> 95*> \param[in] BETA 96*> \verbatim 97*> BETA is REAL 98*> The scalar beta. BETA must be 0., 1., or -1.; otherwise, 99*> it is assumed to be 1. 100*> \endverbatim 101*> 102*> \param[in,out] B 103*> \verbatim 104*> B is COMPLEX array, dimension (LDB,NRHS) 105*> On entry, the N by NRHS matrix B. 106*> On exit, B is overwritten by the matrix expression 107*> B := alpha * A * X + beta * B. 108*> \endverbatim 109*> 110*> \param[in] LDB 111*> \verbatim 112*> LDB is INTEGER 113*> The leading dimension of the array B. LDB >= max(N,1). 114*> \endverbatim 115* 116* Authors: 117* ======== 118* 119*> \author Univ. of Tennessee 120*> \author Univ. of California Berkeley 121*> \author Univ. of Colorado Denver 122*> \author NAG Ltd. 123* 124*> \date December 2016 125* 126*> \ingroup complex_lin 127* 128* ===================================================================== 129 SUBROUTINE CLAPTM( UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B, 130 $ LDB ) 131* 132* -- LAPACK test routine (version 3.7.0) -- 133* -- LAPACK is a software package provided by Univ. of Tennessee, -- 134* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 135* December 2016 136* 137* .. Scalar Arguments .. 138 CHARACTER UPLO 139 INTEGER LDB, LDX, N, NRHS 140 REAL ALPHA, BETA 141* .. 142* .. Array Arguments .. 143 REAL D( * ) 144 COMPLEX B( LDB, * ), E( * ), X( LDX, * ) 145* .. 146* 147* ===================================================================== 148* 149* .. Parameters .. 150 REAL ONE, ZERO 151 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 152* .. 153* .. Local Scalars .. 154 INTEGER I, J 155* .. 156* .. External Functions .. 157 LOGICAL LSAME 158 EXTERNAL LSAME 159* .. 160* .. Intrinsic Functions .. 161 INTRINSIC CONJG 162* .. 163* .. Executable Statements .. 164* 165 IF( N.EQ.0 ) 166 $ RETURN 167* 168 IF( BETA.EQ.ZERO ) THEN 169 DO 20 J = 1, NRHS 170 DO 10 I = 1, N 171 B( I, J ) = ZERO 172 10 CONTINUE 173 20 CONTINUE 174 ELSE IF( BETA.EQ.-ONE ) THEN 175 DO 40 J = 1, NRHS 176 DO 30 I = 1, N 177 B( I, J ) = -B( I, J ) 178 30 CONTINUE 179 40 CONTINUE 180 END IF 181* 182 IF( ALPHA.EQ.ONE ) THEN 183 IF( LSAME( UPLO, 'U' ) ) THEN 184* 185* Compute B := B + A*X, where E is the superdiagonal of A. 186* 187 DO 60 J = 1, NRHS 188 IF( N.EQ.1 ) THEN 189 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) 190 ELSE 191 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) + 192 $ E( 1 )*X( 2, J ) 193 B( N, J ) = B( N, J ) + CONJG( E( N-1 ) )* 194 $ X( N-1, J ) + D( N )*X( N, J ) 195 DO 50 I = 2, N - 1 196 B( I, J ) = B( I, J ) + CONJG( E( I-1 ) )* 197 $ X( I-1, J ) + D( I )*X( I, J ) + 198 $ E( I )*X( I+1, J ) 199 50 CONTINUE 200 END IF 201 60 CONTINUE 202 ELSE 203* 204* Compute B := B + A*X, where E is the subdiagonal of A. 205* 206 DO 80 J = 1, NRHS 207 IF( N.EQ.1 ) THEN 208 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) 209 ELSE 210 B( 1, J ) = B( 1, J ) + D( 1 )*X( 1, J ) + 211 $ CONJG( E( 1 ) )*X( 2, J ) 212 B( N, J ) = B( N, J ) + E( N-1 )*X( N-1, J ) + 213 $ D( N )*X( N, J ) 214 DO 70 I = 2, N - 1 215 B( I, J ) = B( I, J ) + E( I-1 )*X( I-1, J ) + 216 $ D( I )*X( I, J ) + 217 $ CONJG( E( I ) )*X( I+1, J ) 218 70 CONTINUE 219 END IF 220 80 CONTINUE 221 END IF 222 ELSE IF( ALPHA.EQ.-ONE ) THEN 223 IF( LSAME( UPLO, 'U' ) ) THEN 224* 225* Compute B := B - A*X, where E is the superdiagonal of A. 226* 227 DO 100 J = 1, NRHS 228 IF( N.EQ.1 ) THEN 229 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) 230 ELSE 231 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) - 232 $ E( 1 )*X( 2, J ) 233 B( N, J ) = B( N, J ) - CONJG( E( N-1 ) )* 234 $ X( N-1, J ) - D( N )*X( N, J ) 235 DO 90 I = 2, N - 1 236 B( I, J ) = B( I, J ) - CONJG( E( I-1 ) )* 237 $ X( I-1, J ) - D( I )*X( I, J ) - 238 $ E( I )*X( I+1, J ) 239 90 CONTINUE 240 END IF 241 100 CONTINUE 242 ELSE 243* 244* Compute B := B - A*X, where E is the subdiagonal of A. 245* 246 DO 120 J = 1, NRHS 247 IF( N.EQ.1 ) THEN 248 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) 249 ELSE 250 B( 1, J ) = B( 1, J ) - D( 1 )*X( 1, J ) - 251 $ CONJG( E( 1 ) )*X( 2, J ) 252 B( N, J ) = B( N, J ) - E( N-1 )*X( N-1, J ) - 253 $ D( N )*X( N, J ) 254 DO 110 I = 2, N - 1 255 B( I, J ) = B( I, J ) - E( I-1 )*X( I-1, J ) - 256 $ D( I )*X( I, J ) - 257 $ CONJG( E( I ) )*X( I+1, J ) 258 110 CONTINUE 259 END IF 260 120 CONTINUE 261 END IF 262 END IF 263 RETURN 264* 265* End of CLAPTM 266* 267 END 268