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