File:  [local] / rpl / lapack / blas / zgemv.f
Revision 1.17: download - view: text, annotated - select for diffs - revision graph
Mon Aug 7 08:38:45 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 ZGEMV
    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 ZGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
   12: *
   13: *       .. Scalar Arguments ..
   14: *       COMPLEX*16 ALPHA,BETA
   15: *       INTEGER INCX,INCY,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: *> ZGEMV  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 matrix.
   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] ALPHA
   69: *> \verbatim
   70: *>          ALPHA is COMPLEX*16
   71: *>           On entry, ALPHA specifies the scalar alpha.
   72: *> \endverbatim
   73: *>
   74: *> \param[in] A
   75: *> \verbatim
   76: *>          A is COMPLEX*16 array, dimension ( LDA, N )
   77: *>           Before entry, the leading m by n part of the array A must
   78: *>           contain the matrix of coefficients.
   79: *> \endverbatim
   80: *>
   81: *> \param[in] LDA
   82: *> \verbatim
   83: *>          LDA is INTEGER
   84: *>           On entry, LDA specifies the first dimension of A as declared
   85: *>           in the calling (sub) program. LDA must be at least
   86: *>           max( 1, m ).
   87: *> \endverbatim
   88: *>
   89: *> \param[in] X
   90: *> \verbatim
   91: *>          X is COMPLEX*16 array, dimension at least
   92: *>           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
   93: *>           and at least
   94: *>           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
   95: *>           Before entry, the incremented array X must contain the
   96: *>           vector x.
   97: *> \endverbatim
   98: *>
   99: *> \param[in] INCX
  100: *> \verbatim
  101: *>          INCX is INTEGER
  102: *>           On entry, INCX specifies the increment for the elements of
  103: *>           X. INCX must not be zero.
  104: *> \endverbatim
  105: *>
  106: *> \param[in] BETA
  107: *> \verbatim
  108: *>          BETA is COMPLEX*16
  109: *>           On entry, BETA specifies the scalar beta. When BETA is
  110: *>           supplied as zero then Y need not be set on input.
  111: *> \endverbatim
  112: *>
  113: *> \param[in,out] Y
  114: *> \verbatim
  115: *>          Y is COMPLEX*16 array, dimension at least
  116: *>           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
  117: *>           and at least
  118: *>           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
  119: *>           Before entry with BETA non-zero, the incremented array Y
  120: *>           must contain the vector y. On exit, Y is overwritten by the
  121: *>           updated vector y.
  122: *> \endverbatim
  123: *>
  124: *> \param[in] INCY
  125: *> \verbatim
  126: *>          INCY is INTEGER
  127: *>           On entry, INCY specifies the increment for the elements of
  128: *>           Y. INCY must not be zero.
  129: *> \endverbatim
  130: *
  131: *  Authors:
  132: *  ========
  133: *
  134: *> \author Univ. of Tennessee
  135: *> \author Univ. of California Berkeley
  136: *> \author Univ. of Colorado Denver
  137: *> \author NAG Ltd.
  138: *
  139: *> \ingroup complex16_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 ZGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
  158: *
  159: *  -- Reference BLAS level2 routine --
  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: *
  163: *     .. Scalar Arguments ..
  164:       COMPLEX*16 ALPHA,BETA
  165:       INTEGER INCX,INCY,LDA,M,N
  166:       CHARACTER TRANS
  167: *     ..
  168: *     .. Array Arguments ..
  169:       COMPLEX*16 A(LDA,*),X(*),Y(*)
  170: *     ..
  171: *
  172: *  =====================================================================
  173: *
  174: *     .. Parameters ..
  175:       COMPLEX*16 ONE
  176:       PARAMETER (ONE= (1.0D+0,0.0D+0))
  177:       COMPLEX*16 ZERO
  178:       PARAMETER (ZERO= (0.0D+0,0.0D+0))
  179: *     ..
  180: *     .. Local Scalars ..
  181:       COMPLEX*16 TEMP
  182:       INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY,LENX,LENY
  183:       LOGICAL NOCONJ
  184: *     ..
  185: *     .. External Functions ..
  186:       LOGICAL LSAME
  187:       EXTERNAL LSAME
  188: *     ..
  189: *     .. External Subroutines ..
  190:       EXTERNAL XERBLA
  191: *     ..
  192: *     .. Intrinsic Functions ..
  193:       INTRINSIC DCONJG,MAX
  194: *     ..
  195: *
  196: *     Test the input parameters.
  197: *
  198:       INFO = 0
  199:       IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
  200:      +    .NOT.LSAME(TRANS,'C')) THEN
  201:           INFO = 1
  202:       ELSE IF (M.LT.0) THEN
  203:           INFO = 2
  204:       ELSE IF (N.LT.0) THEN
  205:           INFO = 3
  206:       ELSE IF (LDA.LT.MAX(1,M)) THEN
  207:           INFO = 6
  208:       ELSE IF (INCX.EQ.0) THEN
  209:           INFO = 8
  210:       ELSE IF (INCY.EQ.0) THEN
  211:           INFO = 11
  212:       END IF
  213:       IF (INFO.NE.0) THEN
  214:           CALL XERBLA('ZGEMV ',INFO)
  215:           RETURN
  216:       END IF
  217: *
  218: *     Quick return if possible.
  219: *
  220:       IF ((M.EQ.0) .OR. (N.EQ.0) .OR.
  221:      +    ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
  222: *
  223:       NOCONJ = LSAME(TRANS,'T')
  224: *
  225: *     Set  LENX  and  LENY, the lengths of the vectors x and y, and set
  226: *     up the start points in  X  and  Y.
  227: *
  228:       IF (LSAME(TRANS,'N')) THEN
  229:           LENX = N
  230:           LENY = M
  231:       ELSE
  232:           LENX = M
  233:           LENY = N
  234:       END IF
  235:       IF (INCX.GT.0) THEN
  236:           KX = 1
  237:       ELSE
  238:           KX = 1 - (LENX-1)*INCX
  239:       END IF
  240:       IF (INCY.GT.0) THEN
  241:           KY = 1
  242:       ELSE
  243:           KY = 1 - (LENY-1)*INCY
  244:       END IF
  245: *
  246: *     Start the operations. In this version the elements of A are
  247: *     accessed sequentially with one pass through A.
  248: *
  249: *     First form  y := beta*y.
  250: *
  251:       IF (BETA.NE.ONE) THEN
  252:           IF (INCY.EQ.1) THEN
  253:               IF (BETA.EQ.ZERO) THEN
  254:                   DO 10 I = 1,LENY
  255:                       Y(I) = ZERO
  256:    10             CONTINUE
  257:               ELSE
  258:                   DO 20 I = 1,LENY
  259:                       Y(I) = BETA*Y(I)
  260:    20             CONTINUE
  261:               END IF
  262:           ELSE
  263:               IY = KY
  264:               IF (BETA.EQ.ZERO) THEN
  265:                   DO 30 I = 1,LENY
  266:                       Y(IY) = ZERO
  267:                       IY = IY + INCY
  268:    30             CONTINUE
  269:               ELSE
  270:                   DO 40 I = 1,LENY
  271:                       Y(IY) = BETA*Y(IY)
  272:                       IY = IY + INCY
  273:    40             CONTINUE
  274:               END IF
  275:           END IF
  276:       END IF
  277:       IF (ALPHA.EQ.ZERO) RETURN
  278:       IF (LSAME(TRANS,'N')) THEN
  279: *
  280: *        Form  y := alpha*A*x + y.
  281: *
  282:           JX = KX
  283:           IF (INCY.EQ.1) THEN
  284:               DO 60 J = 1,N
  285:                   TEMP = ALPHA*X(JX)
  286:                   DO 50 I = 1,M
  287:                       Y(I) = Y(I) + TEMP*A(I,J)
  288:    50             CONTINUE
  289:                   JX = JX + INCX
  290:    60         CONTINUE
  291:           ELSE
  292:               DO 80 J = 1,N
  293:                   TEMP = ALPHA*X(JX)
  294:                   IY = KY
  295:                   DO 70 I = 1,M
  296:                       Y(IY) = Y(IY) + TEMP*A(I,J)
  297:                       IY = IY + INCY
  298:    70             CONTINUE
  299:                   JX = JX + INCX
  300:    80         CONTINUE
  301:           END IF
  302:       ELSE
  303: *
  304: *        Form  y := alpha*A**T*x + y  or  y := alpha*A**H*x + y.
  305: *
  306:           JY = KY
  307:           IF (INCX.EQ.1) THEN
  308:               DO 110 J = 1,N
  309:                   TEMP = ZERO
  310:                   IF (NOCONJ) THEN
  311:                       DO 90 I = 1,M
  312:                           TEMP = TEMP + A(I,J)*X(I)
  313:    90                 CONTINUE
  314:                   ELSE
  315:                       DO 100 I = 1,M
  316:                           TEMP = TEMP + DCONJG(A(I,J))*X(I)
  317:   100                 CONTINUE
  318:                   END IF
  319:                   Y(JY) = Y(JY) + ALPHA*TEMP
  320:                   JY = JY + INCY
  321:   110         CONTINUE
  322:           ELSE
  323:               DO 140 J = 1,N
  324:                   TEMP = ZERO
  325:                   IX = KX
  326:                   IF (NOCONJ) THEN
  327:                       DO 120 I = 1,M
  328:                           TEMP = TEMP + A(I,J)*X(IX)
  329:                           IX = IX + INCX
  330:   120                 CONTINUE
  331:                   ELSE
  332:                       DO 130 I = 1,M
  333:                           TEMP = TEMP + DCONJG(A(I,J))*X(IX)
  334:                           IX = IX + INCX
  335:   130                 CONTINUE
  336:                   END IF
  337:                   Y(JY) = Y(JY) + ALPHA*TEMP
  338:                   JY = JY + INCY
  339:   140         CONTINUE
  340:           END IF
  341:       END IF
  342: *
  343:       RETURN
  344: *
  345: *     End of ZGEMV
  346: *
  347:       END

CVSweb interface <joel.bertrand@systella.fr>