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