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

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

CVSweb interface <joel.bertrand@systella.fr>