 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE SGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) 00002 * .. Scalar Arguments .. 00003 REAL ALPHA,BETA 00004 INTEGER INCX,INCY,KL,KU,LDA,M,N 00005 CHARACTER TRANS 00006 * .. 00007 * .. Array Arguments .. 00008 REAL A(LDA,*),X(*),Y(*) 00009 * .. 00010 * 00011 * Purpose 00012 * ======= 00013 * 00014 * SGBMV performs one of the matrix-vector operations 00015 * 00016 * y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, 00017 * 00018 * where alpha and beta are scalars, x and y are vectors and A is an 00019 * m by n band matrix, with kl sub-diagonals and ku super-diagonals. 00020 * 00021 * Arguments 00022 * ========== 00023 * 00024 * TRANS - CHARACTER*1. 00025 * On entry, TRANS specifies the operation to be performed as 00026 * follows: 00027 * 00028 * TRANS = 'N' or 'n' y := alpha*A*x + beta*y. 00029 * 00030 * TRANS = 'T' or 't' y := alpha*A**T*x + beta*y. 00031 * 00032 * TRANS = 'C' or 'c' y := alpha*A**T*x + beta*y. 00033 * 00034 * Unchanged on exit. 00035 * 00036 * M - INTEGER. 00037 * On entry, M specifies the number of rows of the matrix A. 00038 * M must be at least zero. 00039 * Unchanged on exit. 00040 * 00041 * N - INTEGER. 00042 * On entry, N specifies the number of columns of the matrix A. 00043 * N must be at least zero. 00044 * Unchanged on exit. 00045 * 00046 * KL - INTEGER. 00047 * On entry, KL specifies the number of sub-diagonals of the 00048 * matrix A. KL must satisfy 0 .le. KL. 00049 * Unchanged on exit. 00050 * 00051 * KU - INTEGER. 00052 * On entry, KU specifies the number of super-diagonals of the 00053 * matrix A. KU must satisfy 0 .le. KU. 00054 * Unchanged on exit. 00055 * 00056 * ALPHA - REAL . 00057 * On entry, ALPHA specifies the scalar alpha. 00058 * Unchanged on exit. 00059 * 00060 * A - REAL array of DIMENSION ( LDA, n ). 00061 * Before entry, the leading ( kl + ku + 1 ) by n part of the 00062 * array A must contain the matrix of coefficients, supplied 00063 * column by column, with the leading diagonal of the matrix in 00064 * row ( ku + 1 ) of the array, the first super-diagonal 00065 * starting at position 2 in row ku, the first sub-diagonal 00066 * starting at position 1 in row ( ku + 2 ), and so on. 00067 * Elements in the array A that do not correspond to elements 00068 * in the band matrix (such as the top left ku by ku triangle) 00069 * are not referenced. 00070 * The following program segment will transfer a band matrix 00071 * from conventional full matrix storage to band storage: 00072 * 00073 * DO 20, J = 1, N 00074 * K = KU + 1 - J 00075 * DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL ) 00076 * A( K + I, J ) = matrix( I, J ) 00077 * 10 CONTINUE 00078 * 20 CONTINUE 00079 * 00080 * Unchanged on exit. 00081 * 00082 * LDA - INTEGER. 00083 * On entry, LDA specifies the first dimension of A as declared 00084 * in the calling (sub) program. LDA must be at least 00085 * ( kl + ku + 1 ). 00086 * Unchanged on exit. 00087 * 00088 * X - REAL array of DIMENSION at least 00089 * ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' 00090 * and at least 00091 * ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. 00092 * Before entry, the incremented array X must contain the 00093 * vector x. 00094 * Unchanged on exit. 00095 * 00096 * INCX - INTEGER. 00097 * On entry, INCX specifies the increment for the elements of 00098 * X. INCX must not be zero. 00099 * Unchanged on exit. 00100 * 00101 * BETA - REAL . 00102 * On entry, BETA specifies the scalar beta. When BETA is 00103 * supplied as zero then Y need not be set on input. 00104 * Unchanged on exit. 00105 * 00106 * Y - REAL array of DIMENSION at least 00107 * ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' 00108 * and at least 00109 * ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. 00110 * Before entry, the incremented array Y must contain the 00111 * vector y. On exit, Y is overwritten by the updated vector y. 00112 * 00113 * INCY - INTEGER. 00114 * On entry, INCY specifies the increment for the elements of 00115 * Y. INCY must not be zero. 00116 * Unchanged on exit. 00117 * 00118 * Further Details 00119 * =============== 00120 * 00121 * Level 2 Blas routine. 00122 * The vector and matrix arguments are not referenced when N = 0, or M = 0 00123 * 00124 * -- Written on 22-October-1986. 00125 * Jack Dongarra, Argonne National Lab. 00126 * Jeremy Du Croz, Nag Central Office. 00127 * Sven Hammarling, Nag Central Office. 00128 * Richard Hanson, Sandia National Labs. 00129 * 00130 * ===================================================================== 00131 * 00132 * .. Parameters .. 00133 REAL ONE,ZERO 00134 PARAMETER (ONE=1.0E+0,ZERO=0.0E+0) 00135 * .. 00136 * .. Local Scalars .. 00137 REAL TEMP 00138 INTEGER I,INFO,IX,IY,J,JX,JY,K,KUP1,KX,KY,LENX,LENY 00139 * .. 00140 * .. External Functions .. 00141 LOGICAL LSAME 00142 EXTERNAL LSAME 00143 * .. 00144 * .. External Subroutines .. 00145 EXTERNAL XERBLA 00146 * .. 00147 * .. Intrinsic Functions .. 00148 INTRINSIC MAX,MIN 00149 * .. 00150 * 00151 * Test the input parameters. 00152 * 00153 INFO = 0 00154 IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. 00155 + .NOT.LSAME(TRANS,'C')) THEN 00156 INFO = 1 00157 ELSE IF (M.LT.0) THEN 00158 INFO = 2 00159 ELSE IF (N.LT.0) THEN 00160 INFO = 3 00161 ELSE IF (KL.LT.0) THEN 00162 INFO = 4 00163 ELSE IF (KU.LT.0) THEN 00164 INFO = 5 00165 ELSE IF (LDA.LT. (KL+KU+1)) THEN 00166 INFO = 8 00167 ELSE IF (INCX.EQ.0) THEN 00168 INFO = 10 00169 ELSE IF (INCY.EQ.0) THEN 00170 INFO = 13 00171 END IF 00172 IF (INFO.NE.0) THEN 00173 CALL XERBLA('SGBMV ',INFO) 00174 RETURN 00175 END IF 00176 * 00177 * Quick return if possible. 00178 * 00179 IF ((M.EQ.0) .OR. (N.EQ.0) .OR. 00180 + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN 00181 * 00182 * Set LENX and LENY, the lengths of the vectors x and y, and set 00183 * up the start points in X and Y. 00184 * 00185 IF (LSAME(TRANS,'N')) THEN 00186 LENX = N 00187 LENY = M 00188 ELSE 00189 LENX = M 00190 LENY = N 00191 END IF 00192 IF (INCX.GT.0) THEN 00193 KX = 1 00194 ELSE 00195 KX = 1 - (LENX-1)*INCX 00196 END IF 00197 IF (INCY.GT.0) THEN 00198 KY = 1 00199 ELSE 00200 KY = 1 - (LENY-1)*INCY 00201 END IF 00202 * 00203 * Start the operations. In this version the elements of A are 00204 * accessed sequentially with one pass through the band part of A. 00205 * 00206 * First form y := beta*y. 00207 * 00208 IF (BETA.NE.ONE) THEN 00209 IF (INCY.EQ.1) THEN 00210 IF (BETA.EQ.ZERO) THEN 00211 DO 10 I = 1,LENY 00212 Y(I) = ZERO 00213 10 CONTINUE 00214 ELSE 00215 DO 20 I = 1,LENY 00216 Y(I) = BETA*Y(I) 00217 20 CONTINUE 00218 END IF 00219 ELSE 00220 IY = KY 00221 IF (BETA.EQ.ZERO) THEN 00222 DO 30 I = 1,LENY 00223 Y(IY) = ZERO 00224 IY = IY + INCY 00225 30 CONTINUE 00226 ELSE 00227 DO 40 I = 1,LENY 00228 Y(IY) = BETA*Y(IY) 00229 IY = IY + INCY 00230 40 CONTINUE 00231 END IF 00232 END IF 00233 END IF 00234 IF (ALPHA.EQ.ZERO) RETURN 00235 KUP1 = KU + 1 00236 IF (LSAME(TRANS,'N')) THEN 00237 * 00238 * Form y := alpha*A*x + y. 00239 * 00240 JX = KX 00241 IF (INCY.EQ.1) THEN 00242 DO 60 J = 1,N 00243 IF (X(JX).NE.ZERO) THEN 00244 TEMP = ALPHA*X(JX) 00245 K = KUP1 - J 00246 DO 50 I = MAX(1,J-KU),MIN(M,J+KL) 00247 Y(I) = Y(I) + TEMP*A(K+I,J) 00248 50 CONTINUE 00249 END IF 00250 JX = JX + INCX 00251 60 CONTINUE 00252 ELSE 00253 DO 80 J = 1,N 00254 IF (X(JX).NE.ZERO) THEN 00255 TEMP = ALPHA*X(JX) 00256 IY = KY 00257 K = KUP1 - J 00258 DO 70 I = MAX(1,J-KU),MIN(M,J+KL) 00259 Y(IY) = Y(IY) + TEMP*A(K+I,J) 00260 IY = IY + INCY 00261 70 CONTINUE 00262 END IF 00263 JX = JX + INCX 00264 IF (J.GT.KU) KY = KY + INCY 00265 80 CONTINUE 00266 END IF 00267 ELSE 00268 * 00269 * Form y := alpha*A**T*x + y. 00270 * 00271 JY = KY 00272 IF (INCX.EQ.1) THEN 00273 DO 100 J = 1,N 00274 TEMP = ZERO 00275 K = KUP1 - J 00276 DO 90 I = MAX(1,J-KU),MIN(M,J+KL) 00277 TEMP = TEMP + A(K+I,J)*X(I) 00278 90 CONTINUE 00279 Y(JY) = Y(JY) + ALPHA*TEMP 00280 JY = JY + INCY 00281 100 CONTINUE 00282 ELSE 00283 DO 120 J = 1,N 00284 TEMP = ZERO 00285 IX = KX 00286 K = KUP1 - J 00287 DO 110 I = MAX(1,J-KU),MIN(M,J+KL) 00288 TEMP = TEMP + A(K+I,J)*X(IX) 00289 IX = IX + INCX 00290 110 CONTINUE 00291 Y(JY) = Y(JY) + ALPHA*TEMP 00292 JY = JY + INCY 00293 IF (J.GT.KU) KX = KX + INCX 00294 120 CONTINUE 00295 END IF 00296 END IF 00297 * 00298 RETURN 00299 * 00300 * End of SGBMV . 00301 * 00302 END
1.7.3 
