![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CSBMV 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 CSBMV( UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, 00012 * INCY ) 00013 * 00014 * .. Scalar Arguments .. 00015 * CHARACTER UPLO 00016 * INTEGER INCX, INCY, K, LDA, N 00017 * COMPLEX ALPHA, BETA 00018 * .. 00019 * .. Array Arguments .. 00020 * COMPLEX A( LDA, * ), X( * ), Y( * ) 00021 * .. 00022 * 00023 * 00024 *> \par Purpose: 00025 * ============= 00026 *> 00027 *> \verbatim 00028 *> 00029 *> CSBMV performs the matrix-vector operation 00030 *> 00031 *> y := alpha*A*x + beta*y, 00032 *> 00033 *> where alpha and beta are scalars, x and y are n element vectors and 00034 *> A is an n by n symmetric band matrix, with k super-diagonals. 00035 *> \endverbatim 00036 * 00037 * Arguments: 00038 * ========== 00039 * 00040 *> \verbatim 00041 *> UPLO - CHARACTER*1 00042 *> On entry, UPLO specifies whether the upper or lower 00043 *> triangular part of the band matrix A is being supplied as 00044 *> follows: 00045 *> 00046 *> UPLO = 'U' or 'u' The upper triangular part of A is 00047 *> being supplied. 00048 *> 00049 *> UPLO = 'L' or 'l' The lower triangular part of A is 00050 *> being supplied. 00051 *> 00052 *> Unchanged on exit. 00053 *> 00054 *> N - INTEGER 00055 *> On entry, N specifies the order of the matrix A. 00056 *> N must be at least zero. 00057 *> Unchanged on exit. 00058 *> 00059 *> K - INTEGER 00060 *> On entry, K specifies the number of super-diagonals of the 00061 *> matrix A. K must satisfy 0 .le. K. 00062 *> Unchanged on exit. 00063 *> 00064 *> ALPHA - COMPLEX 00065 *> On entry, ALPHA specifies the scalar alpha. 00066 *> Unchanged on exit. 00067 *> 00068 *> A - COMPLEX array, dimension( LDA, N ) 00069 *> Before entry with UPLO = 'U' or 'u', the leading ( k + 1 ) 00070 *> by n part of the array A must contain the upper triangular 00071 *> band part of the symmetric matrix, supplied column by 00072 *> column, with the leading diagonal of the matrix in row 00073 *> ( k + 1 ) of the array, the first super-diagonal starting at 00074 *> position 2 in row k, and so on. The top left k by k triangle 00075 *> of the array A is not referenced. 00076 *> The following program segment will transfer the upper 00077 *> triangular part of a symmetric band matrix from conventional 00078 *> full matrix storage to band storage: 00079 *> 00080 *> DO 20, J = 1, N 00081 *> M = K + 1 - J 00082 *> DO 10, I = MAX( 1, J - K ), J 00083 *> A( M + I, J ) = matrix( I, J ) 00084 *> 10 CONTINUE 00085 *> 20 CONTINUE 00086 *> 00087 *> Before entry with UPLO = 'L' or 'l', the leading ( k + 1 ) 00088 *> by n part of the array A must contain the lower triangular 00089 *> band part of the symmetric matrix, supplied column by 00090 *> column, with the leading diagonal of the matrix in row 1 of 00091 *> the array, the first sub-diagonal starting at position 1 in 00092 *> row 2, and so on. The bottom right k by k triangle of the 00093 *> array A is not referenced. 00094 *> The following program segment will transfer the lower 00095 *> triangular part of a symmetric band matrix from conventional 00096 *> full matrix storage to band storage: 00097 *> 00098 *> DO 20, J = 1, N 00099 *> M = 1 - J 00100 *> DO 10, I = J, MIN( N, J + K ) 00101 *> A( M + I, J ) = matrix( I, J ) 00102 *> 10 CONTINUE 00103 *> 20 CONTINUE 00104 *> 00105 *> Unchanged on exit. 00106 *> 00107 *> LDA - INTEGER 00108 *> On entry, LDA specifies the first dimension of A as declared 00109 *> in the calling (sub) program. LDA must be at least 00110 *> ( k + 1 ). 00111 *> Unchanged on exit. 00112 *> 00113 *> X - COMPLEX array, dimension at least 00114 *> ( 1 + ( N - 1 )*abs( INCX ) ). 00115 *> Before entry, the incremented array X must contain the 00116 *> vector x. 00117 *> Unchanged on exit. 00118 *> 00119 *> INCX - INTEGER 00120 *> On entry, INCX specifies the increment for the elements of 00121 *> X. INCX must not be zero. 00122 *> Unchanged on exit. 00123 *> 00124 *> BETA - COMPLEX 00125 *> On entry, BETA specifies the scalar beta. 00126 *> Unchanged on exit. 00127 *> 00128 *> Y - COMPLEX array, dimension at least 00129 *> ( 1 + ( N - 1 )*abs( INCY ) ). 00130 *> Before entry, the incremented array Y must contain the 00131 *> vector y. On exit, Y is overwritten by the updated vector y. 00132 *> 00133 *> INCY - INTEGER 00134 *> On entry, INCY specifies the increment for the elements of 00135 *> Y. INCY must not be zero. 00136 *> Unchanged on exit. 00137 *> \endverbatim 00138 * 00139 * Authors: 00140 * ======== 00141 * 00142 *> \author Univ. of Tennessee 00143 *> \author Univ. of California Berkeley 00144 *> \author Univ. of Colorado Denver 00145 *> \author NAG Ltd. 00146 * 00147 *> \date November 2011 00148 * 00149 *> \ingroup complex_eig 00150 * 00151 * ===================================================================== 00152 SUBROUTINE CSBMV( UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, 00153 $ INCY ) 00154 * 00155 * -- LAPACK test routine (version 3.4.0) -- 00156 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00157 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00158 * November 2011 00159 * 00160 * .. Scalar Arguments .. 00161 CHARACTER UPLO 00162 INTEGER INCX, INCY, K, LDA, N 00163 COMPLEX ALPHA, BETA 00164 * .. 00165 * .. Array Arguments .. 00166 COMPLEX A( LDA, * ), X( * ), Y( * ) 00167 * .. 00168 * 00169 * ===================================================================== 00170 * 00171 * .. Parameters .. 00172 COMPLEX ONE 00173 PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) ) 00174 COMPLEX ZERO 00175 PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ) ) 00176 * .. 00177 * .. Local Scalars .. 00178 INTEGER I, INFO, IX, IY, J, JX, JY, KPLUS1, KX, KY, L 00179 COMPLEX TEMP1, TEMP2 00180 * .. 00181 * .. External Functions .. 00182 LOGICAL LSAME 00183 EXTERNAL LSAME 00184 * .. 00185 * .. External Subroutines .. 00186 EXTERNAL XERBLA 00187 * .. 00188 * .. Intrinsic Functions .. 00189 INTRINSIC MAX, MIN 00190 * .. 00191 * .. Executable Statements .. 00192 * 00193 * Test the input parameters. 00194 * 00195 INFO = 0 00196 IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00197 INFO = 1 00198 ELSE IF( N.LT.0 ) THEN 00199 INFO = 2 00200 ELSE IF( K.LT.0 ) THEN 00201 INFO = 3 00202 ELSE IF( LDA.LT.( K+1 ) ) THEN 00203 INFO = 6 00204 ELSE IF( INCX.EQ.0 ) THEN 00205 INFO = 8 00206 ELSE IF( INCY.EQ.0 ) THEN 00207 INFO = 11 00208 END IF 00209 IF( INFO.NE.0 ) THEN 00210 CALL XERBLA( 'CSBMV ', INFO ) 00211 RETURN 00212 END IF 00213 * 00214 * Quick return if possible. 00215 * 00216 IF( ( N.EQ.0 ) .OR. ( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ONE ) ) ) 00217 $ RETURN 00218 * 00219 * Set up the start points in X and Y. 00220 * 00221 IF( INCX.GT.0 ) THEN 00222 KX = 1 00223 ELSE 00224 KX = 1 - ( N-1 )*INCX 00225 END IF 00226 IF( INCY.GT.0 ) THEN 00227 KY = 1 00228 ELSE 00229 KY = 1 - ( N-1 )*INCY 00230 END IF 00231 * 00232 * Start the operations. In this version the elements of the array A 00233 * are accessed sequentially with one pass through A. 00234 * 00235 * First form y := beta*y. 00236 * 00237 IF( BETA.NE.ONE ) THEN 00238 IF( INCY.EQ.1 ) THEN 00239 IF( BETA.EQ.ZERO ) THEN 00240 DO 10 I = 1, N 00241 Y( I ) = ZERO 00242 10 CONTINUE 00243 ELSE 00244 DO 20 I = 1, N 00245 Y( I ) = BETA*Y( I ) 00246 20 CONTINUE 00247 END IF 00248 ELSE 00249 IY = KY 00250 IF( BETA.EQ.ZERO ) THEN 00251 DO 30 I = 1, N 00252 Y( IY ) = ZERO 00253 IY = IY + INCY 00254 30 CONTINUE 00255 ELSE 00256 DO 40 I = 1, N 00257 Y( IY ) = BETA*Y( IY ) 00258 IY = IY + INCY 00259 40 CONTINUE 00260 END IF 00261 END IF 00262 END IF 00263 IF( ALPHA.EQ.ZERO ) 00264 $ RETURN 00265 IF( LSAME( UPLO, 'U' ) ) THEN 00266 * 00267 * Form y when upper triangle of A is stored. 00268 * 00269 KPLUS1 = K + 1 00270 IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN 00271 DO 60 J = 1, N 00272 TEMP1 = ALPHA*X( J ) 00273 TEMP2 = ZERO 00274 L = KPLUS1 - J 00275 DO 50 I = MAX( 1, J-K ), J - 1 00276 Y( I ) = Y( I ) + TEMP1*A( L+I, J ) 00277 TEMP2 = TEMP2 + A( L+I, J )*X( I ) 00278 50 CONTINUE 00279 Y( J ) = Y( J ) + TEMP1*A( KPLUS1, J ) + ALPHA*TEMP2 00280 60 CONTINUE 00281 ELSE 00282 JX = KX 00283 JY = KY 00284 DO 80 J = 1, N 00285 TEMP1 = ALPHA*X( JX ) 00286 TEMP2 = ZERO 00287 IX = KX 00288 IY = KY 00289 L = KPLUS1 - J 00290 DO 70 I = MAX( 1, J-K ), J - 1 00291 Y( IY ) = Y( IY ) + TEMP1*A( L+I, J ) 00292 TEMP2 = TEMP2 + A( L+I, J )*X( IX ) 00293 IX = IX + INCX 00294 IY = IY + INCY 00295 70 CONTINUE 00296 Y( JY ) = Y( JY ) + TEMP1*A( KPLUS1, J ) + ALPHA*TEMP2 00297 JX = JX + INCX 00298 JY = JY + INCY 00299 IF( J.GT.K ) THEN 00300 KX = KX + INCX 00301 KY = KY + INCY 00302 END IF 00303 80 CONTINUE 00304 END IF 00305 ELSE 00306 * 00307 * Form y when lower triangle of A is stored. 00308 * 00309 IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN 00310 DO 100 J = 1, N 00311 TEMP1 = ALPHA*X( J ) 00312 TEMP2 = ZERO 00313 Y( J ) = Y( J ) + TEMP1*A( 1, J ) 00314 L = 1 - J 00315 DO 90 I = J + 1, MIN( N, J+K ) 00316 Y( I ) = Y( I ) + TEMP1*A( L+I, J ) 00317 TEMP2 = TEMP2 + A( L+I, J )*X( I ) 00318 90 CONTINUE 00319 Y( J ) = Y( J ) + ALPHA*TEMP2 00320 100 CONTINUE 00321 ELSE 00322 JX = KX 00323 JY = KY 00324 DO 120 J = 1, N 00325 TEMP1 = ALPHA*X( JX ) 00326 TEMP2 = ZERO 00327 Y( JY ) = Y( JY ) + TEMP1*A( 1, J ) 00328 L = 1 - J 00329 IX = JX 00330 IY = JY 00331 DO 110 I = J + 1, MIN( N, J+K ) 00332 IX = IX + INCX 00333 IY = IY + INCY 00334 Y( IY ) = Y( IY ) + TEMP1*A( L+I, J ) 00335 TEMP2 = TEMP2 + A( L+I, J )*X( IX ) 00336 110 CONTINUE 00337 Y( JY ) = Y( JY ) + ALPHA*TEMP2 00338 JX = JX + INCX 00339 JY = JY + INCY 00340 120 CONTINUE 00341 END IF 00342 END IF 00343 * 00344 RETURN 00345 * 00346 * End of CSBMV 00347 * 00348 END