github.com/gonum/lapack@v0.0.0-20181123203213-e4cdc5a0bff9/internal/testdata/netlib/dgemv.f (about) 1 *> \brief \b DGEMV 2 * 3 * =========== DOCUMENTATION =========== 4 * 5 * Online html documentation available at 6 * http://www.netlib.org/lapack/explore-html/ 7 * 8 * Definition: 9 * =========== 10 * 11 * SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) 12 * 13 * .. Scalar Arguments .. 14 * DOUBLE PRECISION ALPHA,BETA 15 * INTEGER INCX,INCY,LDA,M,N 16 * CHARACTER TRANS 17 * .. 18 * .. Array Arguments .. 19 * DOUBLE PRECISION A(LDA,*),X(*),Y(*) 20 * .. 21 * 22 * 23 *> \par Purpose: 24 * ============= 25 *> 26 *> \verbatim 27 *> 28 *> DGEMV performs one of the matrix-vector operations 29 *> 30 *> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, 31 *> 32 *> where alpha and beta are scalars, x and y are vectors and A is an 33 *> m by n matrix. 34 *> \endverbatim 35 * 36 * Arguments: 37 * ========== 38 * 39 *> \param[in] TRANS 40 *> \verbatim 41 *> TRANS is CHARACTER*1 42 *> On entry, TRANS specifies the operation to be performed as 43 *> follows: 44 *> 45 *> TRANS = 'N' or 'n' y := alpha*A*x + beta*y. 46 *> 47 *> TRANS = 'T' or 't' y := alpha*A**T*x + beta*y. 48 *> 49 *> TRANS = 'C' or 'c' y := alpha*A**T*x + beta*y. 50 *> \endverbatim 51 *> 52 *> \param[in] M 53 *> \verbatim 54 *> M is INTEGER 55 *> On entry, M specifies the number of rows of the matrix A. 56 *> M must be at least zero. 57 *> \endverbatim 58 *> 59 *> \param[in] N 60 *> \verbatim 61 *> N is INTEGER 62 *> On entry, N specifies the number of columns of the matrix A. 63 *> N must be at least zero. 64 *> \endverbatim 65 *> 66 *> \param[in] ALPHA 67 *> \verbatim 68 *> ALPHA is DOUBLE PRECISION. 69 *> On entry, ALPHA specifies the scalar alpha. 70 *> \endverbatim 71 *> 72 *> \param[in] A 73 *> \verbatim 74 *> A is DOUBLE PRECISION array of DIMENSION ( LDA, n ). 75 *> Before entry, the leading m by n part of the array A must 76 *> contain the matrix of coefficients. 77 *> \endverbatim 78 *> 79 *> \param[in] LDA 80 *> \verbatim 81 *> LDA is INTEGER 82 *> On entry, LDA specifies the first dimension of A as declared 83 *> in the calling (sub) program. LDA must be at least 84 *> max( 1, m ). 85 *> \endverbatim 86 *> 87 *> \param[in] X 88 *> \verbatim 89 *> X is DOUBLE PRECISION array of DIMENSION at least 90 *> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' 91 *> and at least 92 *> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. 93 *> Before entry, the incremented array X must contain the 94 *> vector x. 95 *> \endverbatim 96 *> 97 *> \param[in] INCX 98 *> \verbatim 99 *> INCX is INTEGER 100 *> On entry, INCX specifies the increment for the elements of 101 *> X. INCX must not be zero. 102 *> \endverbatim 103 *> 104 *> \param[in] BETA 105 *> \verbatim 106 *> BETA is DOUBLE PRECISION. 107 *> On entry, BETA specifies the scalar beta. When BETA is 108 *> supplied as zero then Y need not be set on input. 109 *> \endverbatim 110 *> 111 *> \param[in,out] Y 112 *> \verbatim 113 *> Y is DOUBLE PRECISION array of DIMENSION at least 114 *> ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' 115 *> and at least 116 *> ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. 117 *> Before entry with BETA non-zero, the incremented array Y 118 *> must contain the vector y. On exit, Y is overwritten by the 119 *> updated vector y. 120 *> \endverbatim 121 *> 122 *> \param[in] INCY 123 *> \verbatim 124 *> INCY is INTEGER 125 *> On entry, INCY specifies the increment for the elements of 126 *> Y. INCY must not be zero. 127 *> \endverbatim 128 * 129 * Authors: 130 * ======== 131 * 132 *> \author Univ. of Tennessee 133 *> \author Univ. of California Berkeley 134 *> \author Univ. of Colorado Denver 135 *> \author NAG Ltd. 136 * 137 *> \date November 2015 138 * 139 *> \ingroup double_blas_level2 140 * 141 *> \par Further Details: 142 * ===================== 143 *> 144 *> \verbatim 145 *> 146 *> Level 2 Blas routine. 147 *> The vector and matrix arguments are not referenced when N = 0, or M = 0 148 *> 149 *> -- Written on 22-October-1986. 150 *> Jack Dongarra, Argonne National Lab. 151 *> Jeremy Du Croz, Nag Central Office. 152 *> Sven Hammarling, Nag Central Office. 153 *> Richard Hanson, Sandia National Labs. 154 *> \endverbatim 155 *> 156 * ===================================================================== 157 SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) 158 * 159 * -- Reference BLAS level2 routine (version 3.6.0) -- 160 * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- 161 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 162 * November 2015 163 * 164 * .. Scalar Arguments .. 165 DOUBLE PRECISION ALPHA,BETA 166 INTEGER INCX,INCY,LDA,M,N 167 CHARACTER TRANS 168 * .. 169 * .. Array Arguments .. 170 DOUBLE PRECISION A(LDA,*),X(*),Y(*) 171 * .. 172 * 173 * ===================================================================== 174 * 175 * .. Parameters .. 176 DOUBLE PRECISION ONE,ZERO 177 PARAMETER (ONE=1.0D+0,ZERO=0.0D+0) 178 * .. 179 * .. Local Scalars .. 180 DOUBLE PRECISION TEMP 181 INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY,LENX,LENY 182 * .. 183 * .. External Functions .. 184 LOGICAL LSAME 185 EXTERNAL LSAME 186 * .. 187 * .. External Subroutines .. 188 EXTERNAL XERBLA 189 * .. 190 * .. Intrinsic Functions .. 191 INTRINSIC MAX 192 * .. 193 * 194 * Test the input parameters. 195 * 196 INFO = 0 197 IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. 198 + .NOT.LSAME(TRANS,'C')) THEN 199 INFO = 1 200 ELSE IF (M.LT.0) THEN 201 INFO = 2 202 ELSE IF (N.LT.0) THEN 203 INFO = 3 204 ELSE IF (LDA.LT.MAX(1,M)) THEN 205 INFO = 6 206 ELSE IF (INCX.EQ.0) THEN 207 INFO = 8 208 ELSE IF (INCY.EQ.0) THEN 209 INFO = 11 210 END IF 211 IF (INFO.NE.0) THEN 212 CALL XERBLA('DGEMV ',INFO) 213 RETURN 214 END IF 215 * 216 * Quick return if possible. 217 * 218 IF ((M.EQ.0) .OR. (N.EQ.0) .OR. 219 + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN 220 * 221 * Set LENX and LENY, the lengths of the vectors x and y, and set 222 * up the start points in X and Y. 223 * 224 IF (LSAME(TRANS,'N')) THEN 225 LENX = N 226 LENY = M 227 ELSE 228 LENX = M 229 LENY = N 230 END IF 231 IF (INCX.GT.0) THEN 232 KX = 1 233 ELSE 234 KX = 1 - (LENX-1)*INCX 235 END IF 236 IF (INCY.GT.0) THEN 237 KY = 1 238 ELSE 239 KY = 1 - (LENY-1)*INCY 240 END IF 241 * 242 * Start the operations. In this version the elements of A are 243 * accessed sequentially with one pass through A. 244 * 245 * First form y := beta*y. 246 * 247 IF (BETA.NE.ONE) THEN 248 IF (INCY.EQ.1) THEN 249 IF (BETA.EQ.ZERO) THEN 250 DO 10 I = 1,LENY 251 Y(I) = ZERO 252 10 CONTINUE 253 ELSE 254 DO 20 I = 1,LENY 255 Y(I) = BETA*Y(I) 256 20 CONTINUE 257 END IF 258 ELSE 259 IY = KY 260 IF (BETA.EQ.ZERO) THEN 261 DO 30 I = 1,LENY 262 Y(IY) = ZERO 263 IY = IY + INCY 264 30 CONTINUE 265 ELSE 266 DO 40 I = 1,LENY 267 Y(IY) = BETA*Y(IY) 268 IY = IY + INCY 269 40 CONTINUE 270 END IF 271 END IF 272 END IF 273 IF (ALPHA.EQ.ZERO) RETURN 274 IF (LSAME(TRANS,'N')) THEN 275 * 276 * Form y := alpha*A*x + y. 277 * 278 JX = KX 279 IF (INCY.EQ.1) THEN 280 DO 60 J = 1,N 281 TEMP = ALPHA*X(JX) 282 DO 50 I = 1,M 283 Y(I) = Y(I) + TEMP*A(I,J) 284 50 CONTINUE 285 JX = JX + INCX 286 60 CONTINUE 287 ELSE 288 DO 80 J = 1,N 289 TEMP = ALPHA*X(JX) 290 IY = KY 291 DO 70 I = 1,M 292 Y(IY) = Y(IY) + TEMP*A(I,J) 293 IY = IY + INCY 294 70 CONTINUE 295 JX = JX + INCX 296 80 CONTINUE 297 END IF 298 ELSE 299 * 300 * Form y := alpha*A**T*x + y. 301 * 302 JY = KY 303 IF (INCX.EQ.1) THEN 304 DO 100 J = 1,N 305 TEMP = ZERO 306 DO 90 I = 1,M 307 TEMP = TEMP + A(I,J)*X(I) 308 90 CONTINUE 309 Y(JY) = Y(JY) + ALPHA*TEMP 310 JY = JY + INCY 311 100 CONTINUE 312 ELSE 313 DO 120 J = 1,N 314 TEMP = ZERO 315 IX = KX 316 DO 110 I = 1,M 317 TEMP = TEMP + A(I,J)*X(IX) 318 IX = IX + INCX 319 110 CONTINUE 320 Y(JY) = Y(JY) + ALPHA*TEMP 321 JY = JY + INCY 322 120 CONTINUE 323 END IF 324 END IF 325 * 326 RETURN 327 * 328 * End of DGEMV . 329 * 330 END