SRC/sla_wwaddw.f

   1 *> \brief \b SLA_WWADDW adds a vector into a doubled-single vector.
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download SLA_WWADDW + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sla_wwaddw.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sla_wwaddw.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sla_wwaddw.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE SLA_WWADDW( N, X, Y, W )
  22 *
  23 *       .. Scalar Arguments ..
  24 *       INTEGER            N
  25 *       ..
  26 *       .. Array Arguments ..
  27 *       REAL               X( * ), Y( * ), W( * )
  28 *       ..
  29 *
  30 *
  31 *> \par Purpose:
  32 *  =============
  33 *>
  34 *> \verbatim
  35 *>
  36 *>    SLA_WWADDW adds a vector W into a doubled-single vector (X, Y).
  37 *>
  38 *>    This works for all extant IBM's hex and binary floating point
  39 *>    arithmetics, but not for decimal.
  40 *> \endverbatim
  41 *
  42 *  Arguments:
  43 *  ==========
  44 *
  45 *> \param[in] N
  46 *> \verbatim
  47 *>          N is INTEGER
  48 *>            The length of vectors X, Y, and W.
  49 *> \endverbatim
  50 *>
  51 *> \param[in,out] X
  52 *> \verbatim
  53 *>          X is REAL array, dimension (N)
  54 *>            The first part of the doubled-single accumulation vector.
  55 *> \endverbatim
  56 *>
  57 *> \param[in,out] Y
  58 *> \verbatim
  59 *>          Y is REAL array, dimension (N)
  60 *>            The second part of the doubled-single accumulation vector.
  61 *> \endverbatim
  62 *>
  63 *> \param[in] W
  64 *> \verbatim
  65 *>          W is REAL array, dimension (N)
  66 *>            The vector to be added.
  67 *> \endverbatim
  68 *
  69 *  Authors:
  70 *  ========
  71 *
  72 *> \author Univ. of Tennessee
  73 *> \author Univ. of California Berkeley
  74 *> \author Univ. of Colorado Denver
  75 *> \author NAG Ltd.
  76 *
  77 *> \date September 2012
  78 *
  79 *> \ingroup realOTHERcomputational
  80 *
  81 *  =====================================================================
  82       SUBROUTINE SLA_WWADDW( N, X, Y, W )
  83 *
  84 *  -- LAPACK computational routine (version 3.4.2) --
  85 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  86 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  87 *     September 2012
  88 *
  89 *     .. Scalar Arguments ..
  90       INTEGER            N
  91 *     ..
  92 *     .. Array Arguments ..
  93       REAL               X( * ), Y( * ), W( * )
  94 *     ..
  95 *
  96 *  =====================================================================
  97 *
  98 *     .. Local Scalars ..
  99       REAL               S
 100       INTEGER            I
 101 *     ..
 102 *     .. Executable Statements ..
 103 *
 104       DO 10 I = 1, N
 105         S = X(I) + W(I)
 106         S = (S + S) - S
 107         Y(I) = ((X(I) - S) + W(I)) + Y(I)
 108         X(I) = S
 109  10   CONTINUE
 110       RETURN
 111       END