|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) 00002 * .. Scalar Arguments .. 00003 DOUBLE PRECISION ALPHA,BETA 00004 INTEGER INCX,INCY,LDA,M,N 00005 CHARACTER TRANS 00006 * .. 00007 * .. Array Arguments .. 00008 DOUBLE PRECISION A(LDA,*),X(*),Y(*) 00009 * .. 00010 * 00011 * Purpose 00012 * ======= 00013 * 00014 * DGEMV performs one of the matrix-vector operations 00015 * 00016 * y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, 00017 * 00018 * where alpha and beta are scalars, x and y are vectors and A is an 00019 * m by n matrix. 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'*x + beta*y. 00031 * 00032 * TRANS = 'C' or 'c' y := alpha*A'*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 * ALPHA - DOUBLE PRECISION. 00047 * On entry, ALPHA specifies the scalar alpha. 00048 * Unchanged on exit. 00049 * 00050 * A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). 00051 * Before entry, the leading m by n part of the array A must 00052 * contain the matrix of coefficients. 00053 * Unchanged on exit. 00054 * 00055 * LDA - INTEGER. 00056 * On entry, LDA specifies the first dimension of A as declared 00057 * in the calling (sub) program. LDA must be at least 00058 * max( 1, m ). 00059 * Unchanged on exit. 00060 * 00061 * X - DOUBLE PRECISION array of DIMENSION at least 00062 * ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' 00063 * and at least 00064 * ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. 00065 * Before entry, the incremented array X must contain the 00066 * vector x. 00067 * Unchanged on exit. 00068 * 00069 * INCX - INTEGER. 00070 * On entry, INCX specifies the increment for the elements of 00071 * X. INCX must not be zero. 00072 * Unchanged on exit. 00073 * 00074 * BETA - DOUBLE PRECISION. 00075 * On entry, BETA specifies the scalar beta. When BETA is 00076 * supplied as zero then Y need not be set on input. 00077 * Unchanged on exit. 00078 * 00079 * Y - DOUBLE PRECISION array of DIMENSION at least 00080 * ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' 00081 * and at least 00082 * ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. 00083 * Before entry with BETA non-zero, the incremented array Y 00084 * must contain the vector y. On exit, Y is overwritten by the 00085 * updated vector y. 00086 * 00087 * INCY - INTEGER. 00088 * On entry, INCY specifies the increment for the elements of 00089 * Y. INCY must not be zero. 00090 * Unchanged on exit. 00091 * 00092 * Further Details 00093 * =============== 00094 * 00095 * Level 2 Blas routine. 00096 * 00097 * -- Written on 22-October-1986. 00098 * Jack Dongarra, Argonne National Lab. 00099 * Jeremy Du Croz, Nag Central Office. 00100 * Sven Hammarling, Nag Central Office. 00101 * Richard Hanson, Sandia National Labs. 00102 * 00103 * ===================================================================== 00104 * 00105 * .. Parameters .. 00106 DOUBLE PRECISION ONE,ZERO 00107 PARAMETER (ONE=1.0D+0,ZERO=0.0D+0) 00108 * .. 00109 * .. Local Scalars .. 00110 DOUBLE PRECISION TEMP 00111 INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY,LENX,LENY 00112 * .. 00113 * .. External Functions .. 00114 LOGICAL LSAME 00115 EXTERNAL LSAME 00116 * .. 00117 * .. External Subroutines .. 00118 EXTERNAL XERBLA 00119 * .. 00120 * .. Intrinsic Functions .. 00121 INTRINSIC MAX 00122 * .. 00123 * 00124 * Test the input parameters. 00125 * 00126 INFO = 0 00127 IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. 00128 + .NOT.LSAME(TRANS,'C')) THEN 00129 INFO = 1 00130 ELSE IF (M.LT.0) THEN 00131 INFO = 2 00132 ELSE IF (N.LT.0) THEN 00133 INFO = 3 00134 ELSE IF (LDA.LT.MAX(1,M)) THEN 00135 INFO = 6 00136 ELSE IF (INCX.EQ.0) THEN 00137 INFO = 8 00138 ELSE IF (INCY.EQ.0) THEN 00139 INFO = 11 00140 END IF 00141 IF (INFO.NE.0) THEN 00142 CALL XERBLA('DGEMV ',INFO) 00143 RETURN 00144 END IF 00145 * 00146 * Quick return if possible. 00147 * 00148 IF ((M.EQ.0) .OR. (N.EQ.0) .OR. 00149 + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN 00150 * 00151 * Set LENX and LENY, the lengths of the vectors x and y, and set 00152 * up the start points in X and Y. 00153 * 00154 IF (LSAME(TRANS,'N')) THEN 00155 LENX = N 00156 LENY = M 00157 ELSE 00158 LENX = M 00159 LENY = N 00160 END IF 00161 IF (INCX.GT.0) THEN 00162 KX = 1 00163 ELSE 00164 KX = 1 - (LENX-1)*INCX 00165 END IF 00166 IF (INCY.GT.0) THEN 00167 KY = 1 00168 ELSE 00169 KY = 1 - (LENY-1)*INCY 00170 END IF 00171 * 00172 * Start the operations. In this version the elements of A are 00173 * accessed sequentially with one pass through A. 00174 * 00175 * First form y := beta*y. 00176 * 00177 IF (BETA.NE.ONE) THEN 00178 IF (INCY.EQ.1) THEN 00179 IF (BETA.EQ.ZERO) THEN 00180 DO 10 I = 1,LENY 00181 Y(I) = ZERO 00182 10 CONTINUE 00183 ELSE 00184 DO 20 I = 1,LENY 00185 Y(I) = BETA*Y(I) 00186 20 CONTINUE 00187 END IF 00188 ELSE 00189 IY = KY 00190 IF (BETA.EQ.ZERO) THEN 00191 DO 30 I = 1,LENY 00192 Y(IY) = ZERO 00193 IY = IY + INCY 00194 30 CONTINUE 00195 ELSE 00196 DO 40 I = 1,LENY 00197 Y(IY) = BETA*Y(IY) 00198 IY = IY + INCY 00199 40 CONTINUE 00200 END IF 00201 END IF 00202 END IF 00203 IF (ALPHA.EQ.ZERO) RETURN 00204 IF (LSAME(TRANS,'N')) THEN 00205 * 00206 * Form y := alpha*A*x + y. 00207 * 00208 JX = KX 00209 IF (INCY.EQ.1) THEN 00210 DO 60 J = 1,N 00211 IF (X(JX).NE.ZERO) THEN 00212 TEMP = ALPHA*X(JX) 00213 DO 50 I = 1,M 00214 Y(I) = Y(I) + TEMP*A(I,J) 00215 50 CONTINUE 00216 END IF 00217 JX = JX + INCX 00218 60 CONTINUE 00219 ELSE 00220 DO 80 J = 1,N 00221 IF (X(JX).NE.ZERO) THEN 00222 TEMP = ALPHA*X(JX) 00223 IY = KY 00224 DO 70 I = 1,M 00225 Y(IY) = Y(IY) + TEMP*A(I,J) 00226 IY = IY + INCY 00227 70 CONTINUE 00228 END IF 00229 JX = JX + INCX 00230 80 CONTINUE 00231 END IF 00232 ELSE 00233 * 00234 * Form y := alpha*A'*x + y. 00235 * 00236 JY = KY 00237 IF (INCX.EQ.1) THEN 00238 DO 100 J = 1,N 00239 TEMP = ZERO 00240 DO 90 I = 1,M 00241 TEMP = TEMP + A(I,J)*X(I) 00242 90 CONTINUE 00243 Y(JY) = Y(JY) + ALPHA*TEMP 00244 JY = JY + INCY 00245 100 CONTINUE 00246 ELSE 00247 DO 120 J = 1,N 00248 TEMP = ZERO 00249 IX = KX 00250 DO 110 I = 1,M 00251 TEMP = TEMP + A(I,J)*X(IX) 00252 IX = IX + INCX 00253 110 CONTINUE 00254 Y(JY) = Y(JY) + ALPHA*TEMP 00255 JY = JY + INCY 00256 120 CONTINUE 00257 END IF 00258 END IF 00259 * 00260 RETURN 00261 * 00262 * End of DGEMV . 00263 * 00264 END
1.7.3 
