|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE ZGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) 00002 * .. Scalar Arguments .. 00003 DOUBLE COMPLEX ALPHA,BETA 00004 INTEGER INCX,INCY,KL,KU,LDA,M,N 00005 CHARACTER TRANS 00006 * .. 00007 * .. Array Arguments .. 00008 DOUBLE COMPLEX A(LDA,*),X(*),Y(*) 00009 * .. 00010 * 00011 * Purpose 00012 * ======= 00013 * 00014 * ZGBMV performs one of the matrix-vector operations 00015 * 00016 * y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, or 00017 * 00018 * y := alpha*conjg( A' )*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'*x + beta*y. 00033 * 00034 * TRANS = 'C' or 'c' y := alpha*conjg( A' )*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*16 . 00059 * On entry, ALPHA specifies the scalar alpha. 00060 * Unchanged on exit. 00061 * 00062 * A - COMPLEX*16 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*16 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*16 . 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*16 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 * 00126 * -- Written on 22-October-1986. 00127 * Jack Dongarra, Argonne National Lab. 00128 * Jeremy Du Croz, Nag Central Office. 00129 * Sven Hammarling, Nag Central Office. 00130 * Richard Hanson, Sandia National Labs. 00131 * 00132 * ===================================================================== 00133 * 00134 * .. Parameters .. 00135 DOUBLE COMPLEX ONE 00136 PARAMETER (ONE= (1.0D+0,0.0D+0)) 00137 DOUBLE COMPLEX ZERO 00138 PARAMETER (ZERO= (0.0D+0,0.0D+0)) 00139 * .. 00140 * .. Local Scalars .. 00141 DOUBLE COMPLEX TEMP 00142 INTEGER I,INFO,IX,IY,J,JX,JY,K,KUP1,KX,KY,LENX,LENY 00143 LOGICAL NOCONJ 00144 * .. 00145 * .. External Functions .. 00146 LOGICAL LSAME 00147 EXTERNAL LSAME 00148 * .. 00149 * .. External Subroutines .. 00150 EXTERNAL XERBLA 00151 * .. 00152 * .. Intrinsic Functions .. 00153 INTRINSIC DCONJG,MAX,MIN 00154 * .. 00155 * 00156 * Test the input parameters. 00157 * 00158 INFO = 0 00159 IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. 00160 + .NOT.LSAME(TRANS,'C')) THEN 00161 INFO = 1 00162 ELSE IF (M.LT.0) THEN 00163 INFO = 2 00164 ELSE IF (N.LT.0) THEN 00165 INFO = 3 00166 ELSE IF (KL.LT.0) THEN 00167 INFO = 4 00168 ELSE IF (KU.LT.0) THEN 00169 INFO = 5 00170 ELSE IF (LDA.LT. (KL+KU+1)) THEN 00171 INFO = 8 00172 ELSE IF (INCX.EQ.0) THEN 00173 INFO = 10 00174 ELSE IF (INCY.EQ.0) THEN 00175 INFO = 13 00176 END IF 00177 IF (INFO.NE.0) THEN 00178 CALL XERBLA('ZGBMV ',INFO) 00179 RETURN 00180 END IF 00181 * 00182 * Quick return if possible. 00183 * 00184 IF ((M.EQ.0) .OR. (N.EQ.0) .OR. 00185 + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN 00186 * 00187 NOCONJ = LSAME(TRANS,'T') 00188 * 00189 * Set LENX and LENY, the lengths of the vectors x and y, and set 00190 * up the start points in X and Y. 00191 * 00192 IF (LSAME(TRANS,'N')) THEN 00193 LENX = N 00194 LENY = M 00195 ELSE 00196 LENX = M 00197 LENY = N 00198 END IF 00199 IF (INCX.GT.0) THEN 00200 KX = 1 00201 ELSE 00202 KX = 1 - (LENX-1)*INCX 00203 END IF 00204 IF (INCY.GT.0) THEN 00205 KY = 1 00206 ELSE 00207 KY = 1 - (LENY-1)*INCY 00208 END IF 00209 * 00210 * Start the operations. In this version the elements of A are 00211 * accessed sequentially with one pass through the band part of A. 00212 * 00213 * First form y := beta*y. 00214 * 00215 IF (BETA.NE.ONE) THEN 00216 IF (INCY.EQ.1) THEN 00217 IF (BETA.EQ.ZERO) THEN 00218 DO 10 I = 1,LENY 00219 Y(I) = ZERO 00220 10 CONTINUE 00221 ELSE 00222 DO 20 I = 1,LENY 00223 Y(I) = BETA*Y(I) 00224 20 CONTINUE 00225 END IF 00226 ELSE 00227 IY = KY 00228 IF (BETA.EQ.ZERO) THEN 00229 DO 30 I = 1,LENY 00230 Y(IY) = ZERO 00231 IY = IY + INCY 00232 30 CONTINUE 00233 ELSE 00234 DO 40 I = 1,LENY 00235 Y(IY) = BETA*Y(IY) 00236 IY = IY + INCY 00237 40 CONTINUE 00238 END IF 00239 END IF 00240 END IF 00241 IF (ALPHA.EQ.ZERO) RETURN 00242 KUP1 = KU + 1 00243 IF (LSAME(TRANS,'N')) THEN 00244 * 00245 * Form y := alpha*A*x + y. 00246 * 00247 JX = KX 00248 IF (INCY.EQ.1) THEN 00249 DO 60 J = 1,N 00250 IF (X(JX).NE.ZERO) THEN 00251 TEMP = ALPHA*X(JX) 00252 K = KUP1 - J 00253 DO 50 I = MAX(1,J-KU),MIN(M,J+KL) 00254 Y(I) = Y(I) + TEMP*A(K+I,J) 00255 50 CONTINUE 00256 END IF 00257 JX = JX + INCX 00258 60 CONTINUE 00259 ELSE 00260 DO 80 J = 1,N 00261 IF (X(JX).NE.ZERO) THEN 00262 TEMP = ALPHA*X(JX) 00263 IY = KY 00264 K = KUP1 - J 00265 DO 70 I = MAX(1,J-KU),MIN(M,J+KL) 00266 Y(IY) = Y(IY) + TEMP*A(K+I,J) 00267 IY = IY + INCY 00268 70 CONTINUE 00269 END IF 00270 JX = JX + INCX 00271 IF (J.GT.KU) KY = KY + INCY 00272 80 CONTINUE 00273 END IF 00274 ELSE 00275 * 00276 * Form y := alpha*A'*x + y or y := alpha*conjg( A' )*x + y. 00277 * 00278 JY = KY 00279 IF (INCX.EQ.1) THEN 00280 DO 110 J = 1,N 00281 TEMP = ZERO 00282 K = KUP1 - J 00283 IF (NOCONJ) THEN 00284 DO 90 I = MAX(1,J-KU),MIN(M,J+KL) 00285 TEMP = TEMP + A(K+I,J)*X(I) 00286 90 CONTINUE 00287 ELSE 00288 DO 100 I = MAX(1,J-KU),MIN(M,J+KL) 00289 TEMP = TEMP + DCONJG(A(K+I,J))*X(I) 00290 100 CONTINUE 00291 END IF 00292 Y(JY) = Y(JY) + ALPHA*TEMP 00293 JY = JY + INCY 00294 110 CONTINUE 00295 ELSE 00296 DO 140 J = 1,N 00297 TEMP = ZERO 00298 IX = KX 00299 K = KUP1 - J 00300 IF (NOCONJ) THEN 00301 DO 120 I = MAX(1,J-KU),MIN(M,J+KL) 00302 TEMP = TEMP + A(K+I,J)*X(IX) 00303 IX = IX + INCX 00304 120 CONTINUE 00305 ELSE 00306 DO 130 I = MAX(1,J-KU),MIN(M,J+KL) 00307 TEMP = TEMP + DCONJG(A(K+I,J))*X(IX) 00308 IX = IX + INCX 00309 130 CONTINUE 00310 END IF 00311 Y(JY) = Y(JY) + ALPHA*TEMP 00312 JY = JY + INCY 00313 IF (J.GT.KU) KX = KX + INCX 00314 140 CONTINUE 00315 END IF 00316 END IF 00317 * 00318 RETURN 00319 * 00320 * End of ZGBMV . 00321 * 00322 END
1.7.3 
