File:  [local] / rpl / lapack / blas / zhemv.f
Revision 1.14: download - view: text, annotated - select for diffs - revision graph
Tue May 29 06:55:15 2018 UTC (5 years, 11 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
Mise à jour de Lapack.

    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: *> \date December 2016
  136: *
  137: *> \ingroup complex16_blas_level2
  138: *
  139: *> \par Further Details:
  140: *  =====================
  141: *>
  142: *> \verbatim
  143: *>
  144: *>  Level 2 Blas routine.
  145: *>  The vector and matrix arguments are not referenced when N = 0, or M = 0
  146: *>
  147: *>  -- Written on 22-October-1986.
  148: *>     Jack Dongarra, Argonne National Lab.
  149: *>     Jeremy Du Croz, Nag Central Office.
  150: *>     Sven Hammarling, Nag Central Office.
  151: *>     Richard Hanson, Sandia National Labs.
  152: *> \endverbatim
  153: *>
  154: *  =====================================================================
  155:       SUBROUTINE ZHEMV(UPLO,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
  156: *
  157: *  -- Reference BLAS level2 routine (version 3.7.0) --
  158: *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
  159: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  160: *     December 2016
  161: *
  162: *     .. Scalar Arguments ..
  163:       COMPLEX*16 ALPHA,BETA
  164:       INTEGER INCX,INCY,LDA,N
  165:       CHARACTER UPLO
  166: *     ..
  167: *     .. Array Arguments ..
  168:       COMPLEX*16 A(LDA,*),X(*),Y(*)
  169: *     ..
  170: *
  171: *  =====================================================================
  172: *
  173: *     .. Parameters ..
  174:       COMPLEX*16 ONE
  175:       PARAMETER (ONE= (1.0D+0,0.0D+0))
  176:       COMPLEX*16 ZERO
  177:       PARAMETER (ZERO= (0.0D+0,0.0D+0))
  178: *     ..
  179: *     .. Local Scalars ..
  180:       COMPLEX*16 TEMP1,TEMP2
  181:       INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
  182: *     ..
  183: *     .. External Functions ..
  184:       LOGICAL LSAME
  185:       EXTERNAL LSAME
  186: *     ..
  187: *     .. External Subroutines ..
  188:       EXTERNAL XERBLA
  189: *     ..
  190: *     .. Intrinsic Functions ..
  191:       INTRINSIC DBLE,DCONJG,MAX
  192: *     ..
  193: *
  194: *     Test the input parameters.
  195: *
  196:       INFO = 0
  197:       IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
  198:           INFO = 1
  199:       ELSE IF (N.LT.0) THEN
  200:           INFO = 2
  201:       ELSE IF (LDA.LT.MAX(1,N)) THEN
  202:           INFO = 5
  203:       ELSE IF (INCX.EQ.0) THEN
  204:           INFO = 7
  205:       ELSE IF (INCY.EQ.0) THEN
  206:           INFO = 10
  207:       END IF
  208:       IF (INFO.NE.0) THEN
  209:           CALL XERBLA('ZHEMV ',INFO)
  210:           RETURN
  211:       END IF
  212: *
  213: *     Quick return if possible.
  214: *
  215:       IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
  216: *
  217: *     Set up the start points in  X  and  Y.
  218: *
  219:       IF (INCX.GT.0) THEN
  220:           KX = 1
  221:       ELSE
  222:           KX = 1 - (N-1)*INCX
  223:       END IF
  224:       IF (INCY.GT.0) THEN
  225:           KY = 1
  226:       ELSE
  227:           KY = 1 - (N-1)*INCY
  228:       END IF
  229: *
  230: *     Start the operations. In this version the elements of A are
  231: *     accessed sequentially with one pass through the triangular part
  232: *     of A.
  233: *
  234: *     First form  y := beta*y.
  235: *
  236:       IF (BETA.NE.ONE) THEN
  237:           IF (INCY.EQ.1) THEN
  238:               IF (BETA.EQ.ZERO) THEN
  239:                   DO 10 I = 1,N
  240:                       Y(I) = ZERO
  241:    10             CONTINUE
  242:               ELSE
  243:                   DO 20 I = 1,N
  244:                       Y(I) = BETA*Y(I)
  245:    20             CONTINUE
  246:               END IF
  247:           ELSE
  248:               IY = KY
  249:               IF (BETA.EQ.ZERO) THEN
  250:                   DO 30 I = 1,N
  251:                       Y(IY) = ZERO
  252:                       IY = IY + INCY
  253:    30             CONTINUE
  254:               ELSE
  255:                   DO 40 I = 1,N
  256:                       Y(IY) = BETA*Y(IY)
  257:                       IY = IY + INCY
  258:    40             CONTINUE
  259:               END IF
  260:           END IF
  261:       END IF
  262:       IF (ALPHA.EQ.ZERO) RETURN
  263:       IF (LSAME(UPLO,'U')) THEN
  264: *
  265: *        Form  y  when A is stored in upper triangle.
  266: *
  267:           IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
  268:               DO 60 J = 1,N
  269:                   TEMP1 = ALPHA*X(J)
  270:                   TEMP2 = ZERO
  271:                   DO 50 I = 1,J - 1
  272:                       Y(I) = Y(I) + TEMP1*A(I,J)
  273:                       TEMP2 = TEMP2 + DCONJG(A(I,J))*X(I)
  274:    50             CONTINUE
  275:                   Y(J) = Y(J) + TEMP1*DBLE(A(J,J)) + ALPHA*TEMP2
  276:    60         CONTINUE
  277:           ELSE
  278:               JX = KX
  279:               JY = KY
  280:               DO 80 J = 1,N
  281:                   TEMP1 = ALPHA*X(JX)
  282:                   TEMP2 = ZERO
  283:                   IX = KX
  284:                   IY = KY
  285:                   DO 70 I = 1,J - 1
  286:                       Y(IY) = Y(IY) + TEMP1*A(I,J)
  287:                       TEMP2 = TEMP2 + DCONJG(A(I,J))*X(IX)
  288:                       IX = IX + INCX
  289:                       IY = IY + INCY
  290:    70             CONTINUE
  291:                   Y(JY) = Y(JY) + TEMP1*DBLE(A(J,J)) + ALPHA*TEMP2
  292:                   JX = JX + INCX
  293:                   JY = JY + INCY
  294:    80         CONTINUE
  295:           END IF
  296:       ELSE
  297: *
  298: *        Form  y  when A is stored in lower triangle.
  299: *
  300:           IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
  301:               DO 100 J = 1,N
  302:                   TEMP1 = ALPHA*X(J)
  303:                   TEMP2 = ZERO
  304:                   Y(J) = Y(J) + TEMP1*DBLE(A(J,J))
  305:                   DO 90 I = J + 1,N
  306:                       Y(I) = Y(I) + TEMP1*A(I,J)
  307:                       TEMP2 = TEMP2 + DCONJG(A(I,J))*X(I)
  308:    90             CONTINUE
  309:                   Y(J) = Y(J) + ALPHA*TEMP2
  310:   100         CONTINUE
  311:           ELSE
  312:               JX = KX
  313:               JY = KY
  314:               DO 120 J = 1,N
  315:                   TEMP1 = ALPHA*X(JX)
  316:                   TEMP2 = ZERO
  317:                   Y(JY) = Y(JY) + TEMP1*DBLE(A(J,J))
  318:                   IX = JX
  319:                   IY = JY
  320:                   DO 110 I = J + 1,N
  321:                       IX = IX + INCX
  322:                       IY = IY + INCY
  323:                       Y(IY) = Y(IY) + TEMP1*A(I,J)
  324:                       TEMP2 = TEMP2 + DCONJG(A(I,J))*X(IX)
  325:   110             CONTINUE
  326:                   Y(JY) = Y(JY) + ALPHA*TEMP2
  327:                   JX = JX + INCX
  328:                   JY = JY + INCY
  329:   120         CONTINUE
  330:           END IF
  331:       END IF
  332: *
  333:       RETURN
  334: *
  335: *     End of ZHEMV .
  336: *
  337:       END

CVSweb interface <joel.bertrand@systella.fr>