pbdvecadd.f

Go to the documentation of this file.

      SUBROUTINE pbdvecadd( ICONTXT, MODE, N, ALPHA, X, INCX, BETA, Y,
     $                      INCY )
*
*  -- PB-BLAS routine (version 2.1) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory.
*     April 28, 1996
*
*     .. Scalar Arguments ..
      CHARACTER*1           MODE
      INTEGER               ICONTXT, INCX, INCY, N
      DOUBLE PRECISION      ALPHA, BETA
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION      X( * ), Y( * )
*
*     ..
*
*  Purpose
*  =======
*
*  PBDVECADD performs a vector X to be added to Y
*    Y := alpha*op(X) + beta*Y,
*  where alpha and beta are scalars, and X and Y are n vectors,
*  and op(X) = X**H if MODE = 'C',
*
*  Arguments
*  =========
*
*  ICONTXT (input) INTEGER
*          ICONTXT is the BLACS mechanism for partitioning communication
*          space.  A defining property of a context is that a message in
*          a context cannot be sent or received in another context.  The
*          BLACS context includes the definition of a grid, and each
*          process' coordinates in it.
*
*  MODE   (input) CHARACTER*1
*          Specifies the transposed, or conjugate transposed vector X
*          to be added to the vector Y
*          = 'C': Conjugate vector X is added for complex data set.
*                 Y = alpha * X**H + beta * Y
*          ELSE : Vector X is added.  Y = alpha*X + beta*Y
*                 if MODE = 'V', BLAS routine may be used.
*
*  N       (input) INTEGER
*          The number of elements of the vectors X and Y to be added.
*          N >= 0.
*
*  ALPHA   (input) DOUBLE PRECISION
*          ALPHA specifies the scalar alpha.
*
*  X       (input) DOUBLE PRECISION array of DIMENSION at least
*          ( 1 + ( N - 1 )*abs( INCX ) )
*          The incremented array X must contain the vector X.
*
*  INCX    (input) INTEGER
*          INCX specifies the increment for the elements of X.
*          INCX <> 0.
*
*  BETA    (input) DOUBLE PRECISION
*          BETA specifies the scalar beta.
*
*  Y       (input/output) DOUBLE PRECISION array of DIMENSION at least
*          ( 1 + ( N - 1 )*abs( INCY ) )
*          On entry with BETA non-zero, the incremented array Y must
*          contain the vector Y.
*          On exit, Y is overwritten by the updated vector Y.
*
*  INCY  - (input) INTEGER
*          INCY specifies the increment for the elements of Y.
*          INCY <> 0.
*
*  =====================================================================
*
*     ..
*     .. Parameters ..
      DOUBLE PRECISION   ZERO,          ONE
      parameter( zero = 0.0d+0, one = 1.0d+0)
*     ..
*     .. Local Scalars ..
      INTEGER            I, IX, IY
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           lsame
*     ..
*     .. External Subroutines ..
      EXTERNAL           dscal, dcopy, daxpy
*     ..
*     .. Executable Statements ..
*
      IF( n.LE.0 .OR. ( alpha.EQ.zero .AND. beta.EQ.one ) ) RETURN
*
      IF( alpha.EQ.zero ) THEN
         IF( beta.EQ.zero ) THEN
            IF( incy.EQ.1 ) THEN
               DO 10 i = 1, n
                  y( i ) = zero
   10          CONTINUE
            ELSE
               iy = 1
               DO 20 i = 1, n
                  y( iy ) = zero
                  iy = iy + incy
   20          CONTINUE
            END IF
*
         ELSE
            IF( lsame( mode, 'V' ) ) THEN
               CALL dscal( n, beta, y, incy )
            ELSE IF( incy.EQ.1 ) THEN
               DO 30 i = 1, n
                  y( i ) = beta * y( i )
   30          CONTINUE
            ELSE
               iy = 1
               DO 40 i = 1, n
                  y( iy ) = beta * y( iy )
                  iy = iy + incy
   40          CONTINUE
            END IF
         END IF
*
      ELSE
         IF( alpha.EQ.one ) THEN
            IF( beta.EQ.zero ) THEN
               IF( lsame( mode, 'V' ) ) THEN
                  CALL dcopy( n, x, incx, y, incy )
               ELSE IF( incx.EQ.1 .AND. incy.EQ.1 ) THEN
                  DO 50 i = 1, n
                     y( i ) = x( i )
   50             CONTINUE
               ELSE
                  ix = 1
                  iy = 1
                  DO 60 i = 1, n
                     y( iy ) = x( ix )
                     ix = ix + incx
                     iy = iy + incy
   60             CONTINUE
               END IF
*
            ELSE IF( beta.EQ.one ) THEN
               IF( incx.EQ.1 .AND. incy.EQ.1 ) THEN
                  DO 70 i = 1, n
                     y( i ) = x( i ) + y( i )
   70             CONTINUE
               ELSE
                  ix = 1
                  iy = 1
                  DO 80 i = 1, n
                     y( iy ) = x( ix ) + y( iy )
                     ix = ix + incx
                     iy = iy + incy
   80             CONTINUE
               END IF
*
            ELSE
               IF( incx.EQ.1 .AND. incy.EQ.1 ) THEN
                  DO 90 i = 1, n
                     y( i ) = x( i ) + beta * y( i )
   90             CONTINUE
               ELSE
                  ix = 1
                  iy = 1
                  DO 100 i = 1, n
                     y( iy ) = x( ix ) + beta * y( iy )
                     ix = ix + incx
                     iy = iy + incy
  100             CONTINUE
               END IF
            END IF
*
         ELSE
            IF( beta.EQ.zero ) THEN
               IF( incx.EQ.1 .AND. incy.EQ.1 ) THEN
                  DO 110 i = 1, n
                     y( i ) = alpha * x( i )
  110             CONTINUE
               ELSE
                  ix = 1
                  iy = 1
                  DO 120 i = 1, n
                     y( iy ) = x( ix )
                     ix = ix + incx
                     iy = iy + incy
  120             CONTINUE
               END IF
*
            ELSE IF( beta.EQ.one ) THEN
               IF( lsame( mode, 'V' ) ) THEN
                  CALL daxpy( n, alpha, x, incx, y, incy )
               ELSE IF( incx.EQ.1 .AND. incy.EQ.1 ) THEN
                  DO 130 i = 1, n
                     y( i ) = alpha * x( i ) + y( i )
  130             CONTINUE
               ELSE
                  ix = 1
                  iy = 1
                  DO 140 i = 1, n
                     y( iy ) = alpha * x( ix ) + y( iy )
                     ix = ix + incx
                     iy = iy + incy
  140             CONTINUE
               END IF
*
            ELSE
               IF( incx.EQ.1 .AND. incy.EQ.1 ) THEN
                  DO 150 i = 1, n
                     y( i ) = alpha * x( i ) + beta * y( i )
  150             CONTINUE
               ELSE
                  ix = 1
                  iy = 1
                  DO 160 i = 1, n
                     y( iy ) = alpha * x( ix ) + beta * y( iy )
                     ix = ix + incx
                     iy = iy + incy
  160             CONTINUE
               END IF
            END IF
         END IF
      END IF
*
      RETURN
*
*     End of PBDVECADD
*
      END