vendor/gonum.org/v1/gonum/lapack/internal/testdata/netlib/dgemv.f

   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