1*> \brief \b CSBMV 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 CSBMV( UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, 12* INCY ) 13* 14* .. Scalar Arguments .. 15* CHARACTER UPLO 16* INTEGER INCX, INCY, K, LDA, N 17* COMPLEX ALPHA, BETA 18* .. 19* .. Array Arguments .. 20* COMPLEX A( LDA, * ), X( * ), Y( * ) 21* .. 22* 23* 24*> \par Purpose: 25* ============= 26*> 27*> \verbatim 28*> 29*> CSBMV performs the matrix-vector operation 30*> 31*> y := alpha*A*x + beta*y, 32*> 33*> where alpha and beta are scalars, x and y are n element vectors and 34*> A is an n by n symmetric band matrix, with k super-diagonals. 35*> \endverbatim 36* 37* Arguments: 38* ========== 39* 40*> \verbatim 41*> UPLO - CHARACTER*1 42*> On entry, UPLO specifies whether the upper or lower 43*> triangular part of the band matrix A is being supplied as 44*> follows: 45*> 46*> UPLO = 'U' or 'u' The upper triangular part of A is 47*> being supplied. 48*> 49*> UPLO = 'L' or 'l' The lower triangular part of A is 50*> being supplied. 51*> 52*> Unchanged on exit. 53*> 54*> N - INTEGER 55*> On entry, N specifies the order of the matrix A. 56*> N must be at least zero. 57*> Unchanged on exit. 58*> 59*> K - INTEGER 60*> On entry, K specifies the number of super-diagonals of the 61*> matrix A. K must satisfy 0 .le. K. 62*> Unchanged on exit. 63*> 64*> ALPHA - COMPLEX 65*> On entry, ALPHA specifies the scalar alpha. 66*> Unchanged on exit. 67*> 68*> A - COMPLEX array, dimension( LDA, N ) 69*> Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) 70*> by n part of the array A must contain the upper triangular 71*> band part of the symmetric matrix, supplied column by 72*> column, with the leading diagonal of the matrix in row 73*> ( k + 1 ) of the array, the first super-diagonal starting at 74*> position 2 in row k, and so on. The top left k by k triangle 75*> of the array A is not referenced. 76*> The following program segment will transfer the upper 77*> triangular part of a symmetric band matrix from conventional 78*> full matrix storage to band storage: 79*> 80*> DO 20, J = 1, N 81*> M = K + 1 - J 82*> DO 10, I = MAX( 1, J - K ), J 83*> A( M + I, J ) = matrix( I, J ) 84*> 10 CONTINUE 85*> 20 CONTINUE 86*> 87*> Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) 88*> by n part of the array A must contain the lower triangular 89*> band part of the symmetric matrix, supplied column by 90*> column, with the leading diagonal of the matrix in row 1 of 91*> the array, the first sub-diagonal starting at position 1 in 92*> row 2, and so on. The bottom right k by k triangle of the 93*> array A is not referenced. 94*> The following program segment will transfer the lower 95*> triangular part of a symmetric band matrix from conventional 96*> full matrix storage to band storage: 97*> 98*> DO 20, J = 1, N 99*> M = 1 - J 100*> DO 10, I = J, MIN( N, J + K ) 101*> A( M + I, J ) = matrix( I, J ) 102*> 10 CONTINUE 103*> 20 CONTINUE 104*> 105*> Unchanged on exit. 106*> 107*> LDA - INTEGER 108*> On entry, LDA specifies the first dimension of A as declared 109*> in the calling (sub) program. LDA must be at least 110*> ( k + 1 ). 111*> Unchanged on exit. 112*> 113*> X - COMPLEX array, dimension at least 114*> ( 1 + ( N - 1 )*abs( INCX ) ). 115*> Before entry, the incremented array X must contain the 116*> vector x. 117*> Unchanged on exit. 118*> 119*> INCX - INTEGER 120*> On entry, INCX specifies the increment for the elements of 121*> X. INCX must not be zero. 122*> Unchanged on exit. 123*> 124*> BETA - COMPLEX 125*> On entry, BETA specifies the scalar beta. 126*> Unchanged on exit. 127*> 128*> Y - COMPLEX array, dimension at least 129*> ( 1 + ( N - 1 )*abs( INCY ) ). 130*> Before entry, the incremented array Y must contain the 131*> vector y. On exit, Y is overwritten by the updated vector y. 132*> 133*> INCY - INTEGER 134*> On entry, INCY specifies the increment for the elements of 135*> Y. INCY must not be zero. 136*> Unchanged on exit. 137*> \endverbatim 138* 139* Authors: 140* ======== 141* 142*> \author Univ. of Tennessee 143*> \author Univ. of California Berkeley 144*> \author Univ. of Colorado Denver 145*> \author NAG Ltd. 146* 147*> \date December 2016 148* 149*> \ingroup complex_lin 150* 151* ===================================================================== 152 SUBROUTINE CSBMV( UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, 153 $ INCY ) 154* 155* -- LAPACK test routine (version 3.7.0) -- 156* -- LAPACK is a software package provided by Univ. of Tennessee, -- 157* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 158* December 2016 159* 160* .. Scalar Arguments .. 161 CHARACTER UPLO 162 INTEGER INCX, INCY, K, LDA, N 163 COMPLEX ALPHA, BETA 164* .. 165* .. Array Arguments .. 166 COMPLEX A( LDA, * ), X( * ), Y( * ) 167* .. 168* 169* ===================================================================== 170* 171* .. Parameters .. 172 COMPLEX ONE 173 PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) 174 COMPLEX ZERO 175 PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ) ) 176* .. 177* .. Local Scalars .. 178 INTEGER I, INFO, IX, IY, J, JX, JY, KPLUS1, KX, KY, L 179 COMPLEX TEMP1, TEMP2 180* .. 181* .. External Functions .. 182 LOGICAL LSAME 183 EXTERNAL LSAME 184* .. 185* .. External Subroutines .. 186 EXTERNAL XERBLA 187* .. 188* .. Intrinsic Functions .. 189 INTRINSIC MAX, MIN 190* .. 191* .. Executable Statements .. 192* 193* Test the input parameters. 194* 195 INFO = 0 196 IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 197 INFO = 1 198 ELSE IF( N.LT.0 ) THEN 199 INFO = 2 200 ELSE IF( K.LT.0 ) THEN 201 INFO = 3 202 ELSE IF( LDA.LT.( K+1 ) ) THEN 203 INFO = 6 204 ELSE IF( INCX.EQ.0 ) THEN 205 INFO = 8 206 ELSE IF( INCY.EQ.0 ) THEN 207 INFO = 11 208 END IF 209 IF( INFO.NE.0 ) THEN 210 CALL XERBLA( 'CSBMV ', INFO ) 211 RETURN 212 END IF 213* 214* Quick return if possible. 215* 216 IF( ( N.EQ.0 ) .OR. ( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ONE ) ) ) 217 $ RETURN 218* 219* Set up the start points in X and Y. 220* 221 IF( INCX.GT.0 ) THEN 222 KX = 1 223 ELSE 224 KX = 1 - ( N-1 )*INCX 225 END IF 226 IF( INCY.GT.0 ) THEN 227 KY = 1 228 ELSE 229 KY = 1 - ( N-1 )*INCY 230 END IF 231* 232* Start the operations. In this version the elements of the array A 233* are accessed sequentially with one pass through A. 234* 235* First form y := beta*y. 236* 237 IF( BETA.NE.ONE ) THEN 238 IF( INCY.EQ.1 ) THEN 239 IF( BETA.EQ.ZERO ) THEN 240 DO 10 I = 1, N 241 Y( I ) = ZERO 242 10 CONTINUE 243 ELSE 244 DO 20 I = 1, N 245 Y( I ) = BETA*Y( I ) 246 20 CONTINUE 247 END IF 248 ELSE 249 IY = KY 250 IF( BETA.EQ.ZERO ) THEN 251 DO 30 I = 1, N 252 Y( IY ) = ZERO 253 IY = IY + INCY 254 30 CONTINUE 255 ELSE 256 DO 40 I = 1, N 257 Y( IY ) = BETA*Y( IY ) 258 IY = IY + INCY 259 40 CONTINUE 260 END IF 261 END IF 262 END IF 263 IF( ALPHA.EQ.ZERO ) 264 $ RETURN 265 IF( LSAME( UPLO, 'U' ) ) THEN 266* 267* Form y when upper triangle of A is stored. 268* 269 KPLUS1 = K + 1 270 IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN 271 DO 60 J = 1, N 272 TEMP1 = ALPHA*X( J ) 273 TEMP2 = ZERO 274 L = KPLUS1 - J 275 DO 50 I = MAX( 1, J-K ), J - 1 276 Y( I ) = Y( I ) + TEMP1*A( L+I, J ) 277 TEMP2 = TEMP2 + A( L+I, J )*X( I ) 278 50 CONTINUE 279 Y( J ) = Y( J ) + TEMP1*A( KPLUS1, J ) + ALPHA*TEMP2 280 60 CONTINUE 281 ELSE 282 JX = KX 283 JY = KY 284 DO 80 J = 1, N 285 TEMP1 = ALPHA*X( JX ) 286 TEMP2 = ZERO 287 IX = KX 288 IY = KY 289 L = KPLUS1 - J 290 DO 70 I = MAX( 1, J-K ), J - 1 291 Y( IY ) = Y( IY ) + TEMP1*A( L+I, J ) 292 TEMP2 = TEMP2 + A( L+I, J )*X( IX ) 293 IX = IX + INCX 294 IY = IY + INCY 295 70 CONTINUE 296 Y( JY ) = Y( JY ) + TEMP1*A( KPLUS1, J ) + ALPHA*TEMP2 297 JX = JX + INCX 298 JY = JY + INCY 299 IF( J.GT.K ) THEN 300 KX = KX + INCX 301 KY = KY + INCY 302 END IF 303 80 CONTINUE 304 END IF 305 ELSE 306* 307* Form y when lower triangle of A is stored. 308* 309 IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN 310 DO 100 J = 1, N 311 TEMP1 = ALPHA*X( J ) 312 TEMP2 = ZERO 313 Y( J ) = Y( J ) + TEMP1*A( 1, J ) 314 L = 1 - J 315 DO 90 I = J + 1, MIN( N, J+K ) 316 Y( I ) = Y( I ) + TEMP1*A( L+I, J ) 317 TEMP2 = TEMP2 + A( L+I, J )*X( I ) 318 90 CONTINUE 319 Y( J ) = Y( J ) + ALPHA*TEMP2 320 100 CONTINUE 321 ELSE 322 JX = KX 323 JY = KY 324 DO 120 J = 1, N 325 TEMP1 = ALPHA*X( JX ) 326 TEMP2 = ZERO 327 Y( JY ) = Y( JY ) + TEMP1*A( 1, J ) 328 L = 1 - J 329 IX = JX 330 IY = JY 331 DO 110 I = J + 1, MIN( N, J+K ) 332 IX = IX + INCX 333 IY = IY + INCY 334 Y( IY ) = Y( IY ) + TEMP1*A( L+I, J ) 335 TEMP2 = TEMP2 + A( L+I, J )*X( IX ) 336 110 CONTINUE 337 Y( JY ) = Y( JY ) + ALPHA*TEMP2 338 JX = JX + INCX 339 JY = JY + INCY 340 120 CONTINUE 341 END IF 342 END IF 343* 344 RETURN 345* 346* End of CSBMV 347* 348 END 349