File:  [local] / rpl / lapack / blas / zhemv.f
Revision 1.16: 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 ZHEMV
    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 ZHEMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
   12: *
   13: *       .. Scalar Arguments ..
   14: *       COMPLEX*16 ALPHA,BETA
   15: *       INTEGER INCX,INCY,LDA,N
   16: *       CHARACTER UPLO
   17: *       ..
   18: *       .. Array Arguments ..
   19: *       COMPLEX*16 A(LDA,*),X(*),Y(*)
   20: *       ..
   21: *
   22: *
   23: *> \par Purpose:
   24: *  =============
   25: *>
   26: *> \verbatim
   27: *>
   28: *> ZHEMV  performs the matrix-vector  operation
   29: *>
   30: *>    y := alpha*A*x + beta*y,
   31: *>
   32: *> where alpha and beta are scalars, x and y are n element vectors and
   33: *> A is an n by n hermitian matrix.
   34: *> \endverbatim
   35: *
   36: *  Arguments:
   37: *  ==========
   38: *
   39: *> \param[in] UPLO
   40: *> \verbatim
   41: *>          UPLO is CHARACTER*1
   42: *>           On entry, UPLO specifies whether the upper or lower
   43: *>           triangular part of the array A is to be referenced as
   44: *>           follows:
   45: *>
   46: *>              UPLO = 'U' or 'u'   Only the upper triangular part of A
   47: *>                                  is to be referenced.
   48: *>
   49: *>              UPLO = 'L' or 'l'   Only the lower triangular part of A
   50: *>                                  is to be referenced.
   51: *> \endverbatim
   52: *>
   53: *> \param[in] N
   54: *> \verbatim
   55: *>          N is INTEGER
   56: *>           On entry, N specifies the order of the matrix A.
   57: *>           N must be at least zero.
   58: *> \endverbatim
   59: *>
   60: *> \param[in] ALPHA
   61: *> \verbatim
   62: *>          ALPHA is COMPLEX*16
   63: *>           On entry, ALPHA specifies the scalar alpha.
   64: *> \endverbatim
   65: *>
   66: *> \param[in] A
   67: *> \verbatim
   68: *>          A is COMPLEX*16 array, dimension ( LDA, N )
   69: *>           Before entry with  UPLO = 'U' or 'u', the leading n by n
   70: *>           upper triangular part of the array A must contain the upper
   71: *>           triangular part of the hermitian matrix and the strictly
   72: *>           lower triangular part of A is not referenced.
   73: *>           Before entry with UPLO = 'L' or 'l', the leading n by n
   74: *>           lower triangular part of the array A must contain the lower
   75: *>           triangular part of the hermitian matrix and the strictly
   76: *>           upper triangular part of A is not referenced.
   77: *>           Note that the imaginary parts of the diagonal elements need
   78: *>           not be set and are assumed to be zero.
   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, n ).
   87: *> \endverbatim
   88: *>
   89: *> \param[in] X
   90: *> \verbatim
   91: *>          X is COMPLEX*16 array, dimension at least
   92: *>           ( 1 + ( n - 1 )*abs( INCX ) ).
   93: *>           Before entry, the incremented array X must contain the n
   94: *>           element vector x.
   95: *> \endverbatim
   96: *>
   97: *> \param[in] INCX
   98: *> \verbatim
   99: *>          INCX is INTEGER
  100: *>           On entry, INCX specifies the increment for the elements of
  101: *>           X. INCX must not be zero.
  102: *> \endverbatim
  103: *>
  104: *> \param[in] BETA
  105: *> \verbatim
  106: *>          BETA is COMPLEX*16
  107: *>           On entry, BETA specifies the scalar beta. When BETA is
  108: *>           supplied as zero then Y need not be set on input.
  109: *> \endverbatim
  110: *>
  111: *> \param[in,out] Y
  112: *> \verbatim
  113: *>          Y is COMPLEX*16 array, dimension at least
  114: *>           ( 1 + ( n - 1 )*abs( INCY ) ).
  115: *>           Before entry, the incremented array Y must contain the n
  116: *>           element vector y. On exit, Y is overwritten by the updated
  117: *>           vector y.
  118: *> \endverbatim
  119: *>
  120: *> \param[in] INCY
  121: *> \verbatim
  122: *>          INCY is INTEGER
  123: *>           On entry, INCY specifies the increment for the elements of
  124: *>           Y. INCY must not be zero.
  125: *> \endverbatim
  126: *
  127: *  Authors:
  128: *  ========
  129: *
  130: *> \author Univ. of Tennessee
  131: *> \author Univ. of California Berkeley
  132: *> \author Univ. of Colorado Denver
  133: *> \author NAG Ltd.
  134: *
  135: *> \ingroup complex16_blas_level2
  136: *
  137: *> \par Further Details:
  138: *  =====================
  139: *>
  140: *> \verbatim
  141: *>
  142: *>  Level 2 Blas routine.
  143: *>  The vector and matrix arguments are not referenced when N = 0, or M = 0
  144: *>
  145: *>  -- Written on 22-October-1986.
  146: *>     Jack Dongarra, Argonne National Lab.
  147: *>     Jeremy Du Croz, Nag Central Office.
  148: *>     Sven Hammarling, Nag Central Office.
  149: *>     Richard Hanson, Sandia National Labs.
  150: *> \endverbatim
  151: *>
  152: *  =====================================================================
  153:       SUBROUTINE ZHEMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
  154: *
  155: *  -- Reference BLAS level2 routine --
  156: *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
  157: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  158: *
  159: *     .. Scalar Arguments ..
  160:       COMPLEX*16 ALPHA,BETA
  161:       INTEGER INCX,INCY,LDA,N
  162:       CHARACTER UPLO
  163: *     ..
  164: *     .. Array Arguments ..
  165:       COMPLEX*16 A(LDA,*),X(*),Y(*)
  166: *     ..
  167: *
  168: *  =====================================================================
  169: *
  170: *     .. Parameters ..
  171:       COMPLEX*16 ONE
  172:       PARAMETER (ONE= (1.0D+0,0.0D+0))
  173:       COMPLEX*16 ZERO
  174:       PARAMETER (ZERO= (0.0D+0,0.0D+0))
  175: *     ..
  176: *     .. Local Scalars ..
  177:       COMPLEX*16 TEMP1,TEMP2
  178:       INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
  179: *     ..
  180: *     .. External Functions ..
  181:       LOGICAL LSAME
  182:       EXTERNAL LSAME
  183: *     ..
  184: *     .. External Subroutines ..
  185:       EXTERNAL XERBLA
  186: *     ..
  187: *     .. Intrinsic Functions ..
  188:       INTRINSIC DBLE,DCONJG,MAX
  189: *     ..
  190: *
  191: *     Test the input parameters.
  192: *
  193:       INFO = 0
  194:       IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
  195:           INFO = 1
  196:       ELSE IF (N.LT.0) THEN
  197:           INFO = 2
  198:       ELSE IF (LDA.LT.MAX(1,N)) THEN
  199:           INFO = 5
  200:       ELSE IF (INCX.EQ.0) THEN
  201:           INFO = 7
  202:       ELSE IF (INCY.EQ.0) THEN
  203:           INFO = 10
  204:       END IF
  205:       IF (INFO.NE.0) THEN
  206:           CALL XERBLA('ZHEMV ',INFO)
  207:           RETURN
  208:       END IF
  209: *
  210: *     Quick return if possible.
  211: *
  212:       IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
  213: *
  214: *     Set up the start points in  X  and  Y.
  215: *
  216:       IF (INCX.GT.0) THEN
  217:           KX = 1
  218:       ELSE
  219:           KX = 1 - (N-1)*INCX
  220:       END IF
  221:       IF (INCY.GT.0) THEN
  222:           KY = 1
  223:       ELSE
  224:           KY = 1 - (N-1)*INCY
  225:       END IF
  226: *
  227: *     Start the operations. In this version the elements of A are
  228: *     accessed sequentially with one pass through the triangular part
  229: *     of A.
  230: *
  231: *     First form  y := beta*y.
  232: *
  233:       IF (BETA.NE.ONE) THEN
  234:           IF (INCY.EQ.1) THEN
  235:               IF (BETA.EQ.ZERO) THEN
  236:                   DO 10 I = 1,N
  237:                       Y(I) = ZERO
  238:    10             CONTINUE
  239:               ELSE
  240:                   DO 20 I = 1,N
  241:                       Y(I) = BETA*Y(I)
  242:    20             CONTINUE
  243:               END IF
  244:           ELSE
  245:               IY = KY
  246:               IF (BETA.EQ.ZERO) THEN
  247:                   DO 30 I = 1,N
  248:                       Y(IY) = ZERO
  249:                       IY = IY + INCY
  250:    30             CONTINUE
  251:               ELSE
  252:                   DO 40 I = 1,N
  253:                       Y(IY) = BETA*Y(IY)
  254:                       IY = IY + INCY
  255:    40             CONTINUE
  256:               END IF
  257:           END IF
  258:       END IF
  259:       IF (ALPHA.EQ.ZERO) RETURN
  260:       IF (LSAME(UPLO,'U')) THEN
  261: *
  262: *        Form  y  when A is stored in upper triangle.
  263: *
  264:           IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
  265:               DO 60 J = 1,N
  266:                   TEMP1 = ALPHA*X(J)
  267:                   TEMP2 = ZERO
  268:                   DO 50 I = 1,J - 1
  269:                       Y(I) = Y(I) + TEMP1*A(I,J)
  270:                       TEMP2 = TEMP2 + DCONJG(A(I,J))*X(I)
  271:    50             CONTINUE
  272:                   Y(J) = Y(J) + TEMP1*DBLE(A(J,J)) + ALPHA*TEMP2
  273:    60         CONTINUE
  274:           ELSE
  275:               JX = KX
  276:               JY = KY
  277:               DO 80 J = 1,N
  278:                   TEMP1 = ALPHA*X(JX)
  279:                   TEMP2 = ZERO
  280:                   IX = KX
  281:                   IY = KY
  282:                   DO 70 I = 1,J - 1
  283:                       Y(IY) = Y(IY) + TEMP1*A(I,J)
  284:                       TEMP2 = TEMP2 + DCONJG(A(I,J))*X(IX)
  285:                       IX = IX + INCX
  286:                       IY = IY + INCY
  287:    70             CONTINUE
  288:                   Y(JY) = Y(JY) + TEMP1*DBLE(A(J,J)) + ALPHA*TEMP2
  289:                   JX = JX + INCX
  290:                   JY = JY + INCY
  291:    80         CONTINUE
  292:           END IF
  293:       ELSE
  294: *
  295: *        Form  y  when A is stored in lower triangle.
  296: *
  297:           IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
  298:               DO 100 J = 1,N
  299:                   TEMP1 = ALPHA*X(J)
  300:                   TEMP2 = ZERO
  301:                   Y(J) = Y(J) + TEMP1*DBLE(A(J,J))
  302:                   DO 90 I = J + 1,N
  303:                       Y(I) = Y(I) + TEMP1*A(I,J)
  304:                       TEMP2 = TEMP2 + DCONJG(A(I,J))*X(I)
  305:    90             CONTINUE
  306:                   Y(J) = Y(J) + ALPHA*TEMP2
  307:   100         CONTINUE
  308:           ELSE
  309:               JX = KX
  310:               JY = KY
  311:               DO 120 J = 1,N
  312:                   TEMP1 = ALPHA*X(JX)
  313:                   TEMP2 = ZERO
  314:                   Y(JY) = Y(JY) + TEMP1*DBLE(A(J,J))
  315:                   IX = JX
  316:                   IY = JY
  317:                   DO 110 I = J + 1,N
  318:                       IX = IX + INCX
  319:                       IY = IY + INCY
  320:                       Y(IY) = Y(IY) + TEMP1*A(I,J)
  321:                       TEMP2 = TEMP2 + DCONJG(A(I,J))*X(IX)
  322:   110             CONTINUE
  323:                   Y(JY) = Y(JY) + ALPHA*TEMP2
  324:                   JX = JX + INCX
  325:                   JY = JY + INCY
  326:   120         CONTINUE
  327:           END IF
  328:       END IF
  329: *
  330:       RETURN
  331: *
  332: *     End of ZHEMV
  333: *
  334:       END

CVSweb interface <joel.bertrand@systella.fr>