File:  [local] / rpl / lapack / blas / zgbmv.f
Revision 1.13: download - view: text, annotated - select for diffs - revision graph
Sat Aug 27 15:37:54 2016 UTC (7 years, 8 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_25, HEAD
Cohérence Blas.

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

CVSweb interface <joel.bertrand@systella.fr>