BLAS/SRC/sgbmv.f

   1 *> \brief \b SGBMV
   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 SGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
  12 *
  13 *       .. Scalar Arguments ..
  14 *       REAL ALPHA,BETA
  15 *       INTEGER INCX,INCY,KL,KU,LDA,M,N
  16 *       CHARACTER TRANS
  17 *       ..
  18 *       .. Array Arguments ..
  19 *       REAL A(LDA,*),X(*),Y(*)
  20 *       ..
  21 *
  22 *
  23 *> \par Purpose:
  24 *  =============
  25 *>
  26 *> \verbatim
  27 *>
  28 *> SGBMV  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 band matrix, with kl sub-diagonals and ku super-diagonals.
  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] KL
  67 *> \verbatim
  68 *>          KL is INTEGER
  69 *>           On entry, KL specifies the number of sub-diagonals of the
  70 *>           matrix A. KL must satisfy  0 .le. KL.
  71 *> \endverbatim
  72 *>
  73 *> \param[in] KU
  74 *> \verbatim
  75 *>          KU is INTEGER
  76 *>           On entry, KU specifies the number of super-diagonals of the
  77 *>           matrix A. KU must satisfy  0 .le. KU.
  78 *> \endverbatim
  79 *>
  80 *> \param[in] ALPHA
  81 *> \verbatim
  82 *>          ALPHA is REAL
  83 *>           On entry, ALPHA specifies the scalar alpha.
  84 *> \endverbatim
  85 *>
  86 *> \param[in] A
  87 *> \verbatim
  88 *>          A is REAL array of DIMENSION ( LDA, n ).
  89 *>           Before entry, the leading ( kl + ku + 1 ) by n part of the
  90 *>           array A must contain the matrix of coefficients, supplied
  91 *>           column by column, with the leading diagonal of the matrix in
  92 *>           row ( ku + 1 ) of the array, the first super-diagonal
  93 *>           starting at position 2 in row ku, the first sub-diagonal
  94 *>           starting at position 1 in row ( ku + 2 ), and so on.
  95 *>           Elements in the array A that do not correspond to elements
  96 *>           in the band matrix (such as the top left ku by ku triangle)
  97 *>           are not referenced.
  98 *>           The following program segment will transfer a band matrix
  99 *>           from conventional full matrix storage to band storage:
 100 *>
 101 *>                 DO 20, J = 1, N
 102 *>                    K = KU + 1 - J
 103 *>                    DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
 104 *>                       A( K + I, J ) = matrix( I, J )
 105 *>              10    CONTINUE
 106 *>              20 CONTINUE
 107 *> \endverbatim
 108 *>
 109 *> \param[in] LDA
 110 *> \verbatim
 111 *>          LDA is INTEGER
 112 *>           On entry, LDA specifies the first dimension of A as declared
 113 *>           in the calling (sub) program. LDA must be at least
 114 *>           ( kl + ku + 1 ).
 115 *> \endverbatim
 116 *>
 117 *> \param[in] X
 118 *> \verbatim
 119 *>          X is REAL array of DIMENSION at least
 120 *>           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
 121 *>           and at least
 122 *>           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
 123 *>           Before entry, the incremented array X must contain the
 124 *>           vector x.
 125 *> \endverbatim
 126 *>
 127 *> \param[in] INCX
 128 *> \verbatim
 129 *>          INCX is INTEGER
 130 *>           On entry, INCX specifies the increment for the elements of
 131 *>           X. INCX must not be zero.
 132 *> \endverbatim
 133 *>
 134 *> \param[in] BETA
 135 *> \verbatim
 136 *>          BETA is REAL
 137 *>           On entry, BETA specifies the scalar beta. When BETA is
 138 *>           supplied as zero then Y need not be set on input.
 139 *> \endverbatim
 140 *>
 141 *> \param[in,out] Y
 142 *> \verbatim
 143 *>          Y is REAL array of DIMENSION at least
 144 *>           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
 145 *>           and at least
 146 *>           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
 147 *>           Before entry, the incremented array Y must contain the
 148 *>           vector y. On exit, Y is overwritten by the updated vector y.
 149 *> \endverbatim
 150 *>
 151 *> \param[in] INCY
 152 *> \verbatim
 153 *>          INCY is INTEGER
 154 *>           On entry, INCY specifies the increment for the elements of
 155 *>           Y. INCY must not be zero.
 156 *> \endverbatim
 157 *
 158 *  Authors:
 159 *  ========
 160 *
 161 *> \author Univ. of Tennessee
 162 *> \author Univ. of California Berkeley
 163 *> \author Univ. of Colorado Denver
 164 *> \author NAG Ltd.
 165 *
 166 *> \date November 2015
 167 *
 168 *> \ingroup single_blas_level2
 169 *
 170 *> \par Further Details:
 171 *  =====================
 172 *>
 173 *> \verbatim
 174 *>
 175 *>  Level 2 Blas routine.
 176 *>  The vector and matrix arguments are not referenced when N = 0, or M = 0
 177 *>
 178 *>  -- Written on 22-October-1986.
 179 *>     Jack Dongarra, Argonne National Lab.
 180 *>     Jeremy Du Croz, Nag Central Office.
 181 *>     Sven Hammarling, Nag Central Office.
 182 *>     Richard Hanson, Sandia National Labs.
 183 *> \endverbatim
 184 *>
 185 *  =====================================================================
 186       SUBROUTINE SGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
 187 *
 188 *  -- Reference BLAS level2 routine (version 3.6.0) --
 189 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 190 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 191 *     November 2015
 192 *
 193 *     .. Scalar Arguments ..
 194       REAL ALPHA,BETA
 195       INTEGER INCX,INCY,KL,KU,LDA,M,N
 196       CHARACTER TRANS
 197 *     ..
 198 *     .. Array Arguments ..
 199       REAL A(LDA,*),X(*),Y(*)
 200 *     ..
 201 *
 202 *  =====================================================================
 203 *
 204 *     .. Parameters ..
 205       REAL ONE,ZERO
 206       PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
 207 *     ..
 208 *     .. Local Scalars ..
 209       REAL TEMP
 210       INTEGER I,INFO,IX,IY,J,JX,JY,K,KUP1,KX,KY,LENX,LENY
 211 *     ..
 212 *     .. External Functions ..
 213       LOGICAL LSAME
 214       EXTERNAL LSAME
 215 *     ..
 216 *     .. External Subroutines ..
 217       EXTERNAL XERBLA
 218 *     ..
 219 *     .. Intrinsic Functions ..
 220       INTRINSIC MAX,MIN
 221 *     ..
 222 *
 223 *     Test the input parameters.
 224 *
 225       INFO = 0
 226       IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
 227      +    .NOT.LSAME(TRANS,'C')) THEN
 228           INFO = 1
 229       ELSE IF (M.LT.0) THEN
 230           INFO = 2
 231       ELSE IF (N.LT.0) THEN
 232           INFO = 3
 233       ELSE IF (KL.LT.0) THEN
 234           INFO = 4
 235       ELSE IF (KU.LT.0) THEN
 236           INFO = 5
 237       ELSE IF (LDA.LT. (KL+KU+1)) THEN
 238           INFO = 8
 239       ELSE IF (INCX.EQ.0) THEN
 240           INFO = 10
 241       ELSE IF (INCY.EQ.0) THEN
 242           INFO = 13
 243       END IF
 244       IF (INFO.NE.0) THEN
 245           CALL XERBLA('SGBMV ',INFO)
 246           RETURN
 247       END IF
 248 *
 249 *     Quick return if possible.
 250 *
 251       IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
 252      +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
 253 *
 254 *     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
 255 *     up the start points in  X  and  Y.
 256 *
 257       IF (LSAME(TRANS,'N')) THEN
 258           LENX = N
 259           LENY = M
 260       ELSE
 261           LENX = M
 262           LENY = N
 263       END IF
 264       IF (INCX.GT.0) THEN
 265           KX = 1
 266       ELSE
 267           KX = 1 - (LENX-1)*INCX
 268       END IF
 269       IF (INCY.GT.0) THEN
 270           KY = 1
 271       ELSE
 272           KY = 1 - (LENY-1)*INCY
 273       END IF
 274 *
 275 *     Start the operations. In this version the elements of A are
 276 *     accessed sequentially with one pass through the band part of A.
 277 *
 278 *     First form  y := beta*y.
 279 *
 280       IF (BETA.NE.ONE) THEN
 281           IF (INCY.EQ.1) THEN
 282               IF (BETA.EQ.ZERO) THEN
 283                   DO 10 I = 1,LENY
 284                       Y(I) = ZERO
 285    10             CONTINUE
 286               ELSE
 287                   DO 20 I = 1,LENY
 288                       Y(I) = BETA*Y(I)
 289    20             CONTINUE
 290               END IF
 291           ELSE
 292               IY = KY
 293               IF (BETA.EQ.ZERO) THEN
 294                   DO 30 I = 1,LENY
 295                       Y(IY) = ZERO
 296                       IY = IY + INCY
 297    30             CONTINUE
 298               ELSE
 299                   DO 40 I = 1,LENY
 300                       Y(IY) = BETA*Y(IY)
 301                       IY = IY + INCY
 302    40             CONTINUE
 303               END IF
 304           END IF
 305       END IF
 306       IF (ALPHA.EQ.ZERO) RETURN
 307       KUP1 = KU + 1
 308       IF (LSAME(TRANS,'N')) THEN
 309 *
 310 *        Form  y := alpha*A*x + y.
 311 *
 312           JX = KX
 313           IF (INCY.EQ.1) THEN
 314               DO 60 J = 1,N
 315                   TEMP = ALPHA*X(JX)
 316                   K = KUP1 - J
 317                   DO 50 I = MAX(1,J-KU),MIN(M,J+KL)
 318                       Y(I) = Y(I) + TEMP*A(K+I,J)
 319    50             CONTINUE
 320                   JX = JX + INCX
 321    60         CONTINUE
 322           ELSE
 323               DO 80 J = 1,N
 324                   TEMP = ALPHA*X(JX)
 325                   IY = KY
 326                   K = KUP1 - J
 327                   DO 70 I = MAX(1,J-KU),MIN(M,J+KL)
 328                       Y(IY) = Y(IY) + TEMP*A(K+I,J)
 329                       IY = IY + INCY
 330    70             CONTINUE
 331                   JX = JX + INCX
 332                   IF (J.GT.KU) KY = KY + INCY
 333    80         CONTINUE
 334           END IF
 335       ELSE
 336 *
 337 *        Form  y := alpha*A**T*x + y.
 338 *
 339           JY = KY
 340           IF (INCX.EQ.1) THEN
 341               DO 100 J = 1,N
 342                   TEMP = ZERO
 343                   K = KUP1 - J
 344                   DO 90 I = MAX(1,J-KU),MIN(M,J+KL)
 345                       TEMP = TEMP + A(K+I,J)*X(I)
 346    90             CONTINUE
 347                   Y(JY) = Y(JY) + ALPHA*TEMP
 348                   JY = JY + INCY
 349   100         CONTINUE
 350           ELSE
 351               DO 120 J = 1,N
 352                   TEMP = ZERO
 353                   IX = KX
 354                   K = KUP1 - J
 355                   DO 110 I = MAX(1,J-KU),MIN(M,J+KL)
 356                       TEMP = TEMP + A(K+I,J)*X(IX)
 357                       IX = IX + INCX
 358   110             CONTINUE
 359                   Y(JY) = Y(JY) + ALPHA*TEMP
 360                   JY = JY + INCY
 361                   IF (J.GT.KU) KX = KX + INCX
 362   120         CONTINUE
 363           END IF
 364       END IF
 365 *
 366       RETURN
 367 *
 368 *     End of SGBMV .
 369 *
 370       END