File:  [local] / rpl / lapack / blas / dgbmv.f
Revision 1.12: download - view: text, annotated - select for diffs - revision graph
Thu Nov 26 11:44:14 2015 UTC (8 years, 5 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_24, HEAD
Mise à jour de Lapack (3.6.0) et du numéro de version du RPL/2.

    1: *> \brief \b DGBMV
    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 DGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
   12:    13: *       .. Scalar Arguments ..
   14: *       DOUBLE PRECISION ALPHA,BETA
   15: *       INTEGER INCX,INCY,KL,KU,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: *> DGBMV  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 DOUBLE PRECISION.
   83: *>           On entry, ALPHA specifies the scalar alpha.
   84: *> \endverbatim
   85: *>
   86: *> \param[in] A
   87: *> \verbatim
   88: *>          A is DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION.
  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 DOUBLE PRECISION 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 double_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 DGBMV(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:       DOUBLE PRECISION ALPHA,BETA
  195:       INTEGER INCX,INCY,KL,KU,LDA,M,N
  196:       CHARACTER TRANS
  197: *     ..
  198: *     .. Array Arguments ..
  199:       DOUBLE PRECISION A(LDA,*),X(*),Y(*)
  200: *     ..
  201: *
  202: *  =====================================================================
  203: *
  204: *     .. Parameters ..
  205:       DOUBLE PRECISION ONE,ZERO
  206:       PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
  207: *     ..
  208: *     .. Local Scalars ..
  209:       DOUBLE PRECISION 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('DGBMV ',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 DGBMV .
  369: *
  370:       END

CVSweb interface <joel.bertrand@systella.fr>