File:  [local] / rpl / lapack / blas / zgbmv.f
Revision 1.17: download - view: text, annotated - select for diffs - revision graph
Mon Aug 7 08:38:44 2023 UTC (8 months, 3 weeks ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_35, rpl-4_1_34, HEAD
Première mise à jour de lapack et 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, 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, 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, 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: *> \ingroup complex16_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 ZGBMV(TRANS,M,N,KL,KU,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
  187: *
  188: *  -- Reference BLAS level2 routine --
  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: *
  192: *     .. Scalar Arguments ..
  193:       COMPLEX*16 ALPHA,BETA
  194:       INTEGER INCX,INCY,KL,KU,LDA,M,N
  195:       CHARACTER TRANS
  196: *     ..
  197: *     .. Array Arguments ..
  198:       COMPLEX*16 A(LDA,*),X(*),Y(*)
  199: *     ..
  200: *
  201: *  =====================================================================
  202: *
  203: *     .. Parameters ..
  204:       COMPLEX*16 ONE
  205:       PARAMETER (ONE= (1.0D+0,0.0D+0))
  206:       COMPLEX*16 ZERO
  207:       PARAMETER (ZERO= (0.0D+0,0.0D+0))
  208: *     ..
  209: *     .. Local Scalars ..
  210:       COMPLEX*16 TEMP
  211:       INTEGER I,INFO,IX,IY,J,JX,JY,K,KUP1,KX,KY,LENX,LENY
  212:       LOGICAL NOCONJ
  213: *     ..
  214: *     .. External Functions ..
  215:       LOGICAL LSAME
  216:       EXTERNAL LSAME
  217: *     ..
  218: *     .. External Subroutines ..
  219:       EXTERNAL XERBLA
  220: *     ..
  221: *     .. Intrinsic Functions ..
  222:       INTRINSIC DCONJG,MAX,MIN
  223: *     ..
  224: *
  225: *     Test the input parameters.
  226: *
  227:       INFO = 0
  228:       IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
  229:      +    .NOT.LSAME(TRANS,'C')) THEN
  230:           INFO = 1
  231:       ELSE IF (M.LT.0) THEN
  232:           INFO = 2
  233:       ELSE IF (N.LT.0) THEN
  234:           INFO = 3
  235:       ELSE IF (KL.LT.0) THEN
  236:           INFO = 4
  237:       ELSE IF (KU.LT.0) THEN
  238:           INFO = 5
  239:       ELSE IF (LDA.LT. (KL+KU+1)) THEN
  240:           INFO = 8
  241:       ELSE IF (INCX.EQ.0) THEN
  242:           INFO = 10
  243:       ELSE IF (INCY.EQ.0) THEN
  244:           INFO = 13
  245:       END IF
  246:       IF (INFO.NE.0) THEN
  247:           CALL XERBLA('ZGBMV ',INFO)
  248:           RETURN
  249:       END IF
  250: *
  251: *     Quick return if possible.
  252: *
  253:       IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
  254:      +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
  255: *
  256:       NOCONJ = LSAME(TRANS,'T')
  257: *
  258: *     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
  259: *     up the start points in  X  and  Y.
  260: *
  261:       IF (LSAME(TRANS,'N')) THEN
  262:           LENX = N
  263:           LENY = M
  264:       ELSE
  265:           LENX = M
  266:           LENY = N
  267:       END IF
  268:       IF (INCX.GT.0) THEN
  269:           KX = 1
  270:       ELSE
  271:           KX = 1 - (LENX-1)*INCX
  272:       END IF
  273:       IF (INCY.GT.0) THEN
  274:           KY = 1
  275:       ELSE
  276:           KY = 1 - (LENY-1)*INCY
  277:       END IF
  278: *
  279: *     Start the operations. In this version the elements of A are
  280: *     accessed sequentially with one pass through the band part of A.
  281: *
  282: *     First form  y := beta*y.
  283: *
  284:       IF (BETA.NE.ONE) THEN
  285:           IF (INCY.EQ.1) THEN
  286:               IF (BETA.EQ.ZERO) THEN
  287:                   DO 10 I = 1,LENY
  288:                       Y(I) = ZERO
  289:    10             CONTINUE
  290:               ELSE
  291:                   DO 20 I = 1,LENY
  292:                       Y(I) = BETA*Y(I)
  293:    20             CONTINUE
  294:               END IF
  295:           ELSE
  296:               IY = KY
  297:               IF (BETA.EQ.ZERO) THEN
  298:                   DO 30 I = 1,LENY
  299:                       Y(IY) = ZERO
  300:                       IY = IY + INCY
  301:    30             CONTINUE
  302:               ELSE
  303:                   DO 40 I = 1,LENY
  304:                       Y(IY) = BETA*Y(IY)
  305:                       IY = IY + INCY
  306:    40             CONTINUE
  307:               END IF
  308:           END IF
  309:       END IF
  310:       IF (ALPHA.EQ.ZERO) RETURN
  311:       KUP1 = KU + 1
  312:       IF (LSAME(TRANS,'N')) THEN
  313: *
  314: *        Form  y := alpha*A*x + y.
  315: *
  316:           JX = KX
  317:           IF (INCY.EQ.1) THEN
  318:               DO 60 J = 1,N
  319:                   TEMP = ALPHA*X(JX)
  320:                   K = KUP1 - J
  321:                   DO 50 I = MAX(1,J-KU),MIN(M,J+KL)
  322:                       Y(I) = Y(I) + TEMP*A(K+I,J)
  323:    50             CONTINUE
  324:                   JX = JX + INCX
  325:    60         CONTINUE
  326:           ELSE
  327:               DO 80 J = 1,N
  328:                   TEMP = ALPHA*X(JX)
  329:                   IY = KY
  330:                   K = KUP1 - J
  331:                   DO 70 I = MAX(1,J-KU),MIN(M,J+KL)
  332:                       Y(IY) = Y(IY) + TEMP*A(K+I,J)
  333:                       IY = IY + INCY
  334:    70             CONTINUE
  335:                   JX = JX + INCX
  336:                   IF (J.GT.KU) KY = KY + INCY
  337:    80         CONTINUE
  338:           END IF
  339:       ELSE
  340: *
  341: *        Form  y := alpha*A**T*x + y  or  y := alpha*A**H*x + y.
  342: *
  343:           JY = KY
  344:           IF (INCX.EQ.1) THEN
  345:               DO 110 J = 1,N
  346:                   TEMP = ZERO
  347:                   K = KUP1 - J
  348:                   IF (NOCONJ) THEN
  349:                       DO 90 I = MAX(1,J-KU),MIN(M,J+KL)
  350:                           TEMP = TEMP + A(K+I,J)*X(I)
  351:    90                 CONTINUE
  352:                   ELSE
  353:                       DO 100 I = MAX(1,J-KU),MIN(M,J+KL)
  354:                           TEMP = TEMP + DCONJG(A(K+I,J))*X(I)
  355:   100                 CONTINUE
  356:                   END IF
  357:                   Y(JY) = Y(JY) + ALPHA*TEMP
  358:                   JY = JY + INCY
  359:   110         CONTINUE
  360:           ELSE
  361:               DO 140 J = 1,N
  362:                   TEMP = ZERO
  363:                   IX = KX
  364:                   K = KUP1 - J
  365:                   IF (NOCONJ) THEN
  366:                       DO 120 I = MAX(1,J-KU),MIN(M,J+KL)
  367:                           TEMP = TEMP + A(K+I,J)*X(IX)
  368:                           IX = IX + INCX
  369:   120                 CONTINUE
  370:                   ELSE
  371:                       DO 130 I = MAX(1,J-KU),MIN(M,J+KL)
  372:                           TEMP = TEMP + DCONJG(A(K+I,J))*X(IX)
  373:                           IX = IX + INCX
  374:   130                 CONTINUE
  375:                   END IF
  376:                   Y(JY) = Y(JY) + ALPHA*TEMP
  377:                   JY = JY + INCY
  378:                   IF (J.GT.KU) KX = KX + INCX
  379:   140         CONTINUE
  380:           END IF
  381:       END IF
  382: *
  383:       RETURN
  384: *
  385: *     End of ZGBMV
  386: *
  387:       END

CVSweb interface <joel.bertrand@systella.fr>