summaryrefslogtreecommitdiff
path: root/SRC/cla_wwaddw.f
blob: b3dc461a06e2a61d5ecbe0578fcfa3a6f8abd0cc (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
      SUBROUTINE CLA_WWADDW( N, X, Y, W )
*
*     -- LAPACK routine (version 3.2.2)                                 --
*     -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
*     -- Jason Riedy of Univ. of California Berkeley.                 --
*     -- June 2010                                                    --
*
*     -- LAPACK is a software package provided by Univ. of Tennessee, --
*     -- Univ. of California Berkeley and NAG Ltd.                    --
*
      IMPLICIT NONE
*     ..
*     .. Scalar Arguments ..
      INTEGER            N
*     ..
*     .. Array Arguments ..
      COMPLEX            X( * ), Y( * ), W( * )
*     ..
*
*  Purpose
*     =======
*
*     CLA_WWADDW adds a vector W into a doubled-single vector (X, Y).
*
*     This works for all extant IBM's hex and binary floating point
*     arithmetics, but not for decimal.
*
*  Arguments
*  =========
*
*     N      (input) INTEGER
*            The length of vectors X, Y, and W.
*
*     X      (input/output) COMPLEX array, dimension (N)
*            The first part of the doubled-single accumulation vector.
*
*     Y      (input/output) COMPLEX array, dimension (N)
*            The second part of the doubled-single accumulation vector.
*
*     W      (input) COMPLEX array, dimension (N)
*            The vector to be added.
*
*  =====================================================================
*
*     .. Local Scalars ..
      COMPLEX            S
      INTEGER            I
*     ..
*     .. Executable Statements ..
*
      DO 10 I = 1, N
        S = X(I) + W(I)
        S = (S + S) - S
        Y(I) = ((X(I) - S) + W(I)) + Y(I)
        X(I) = S
   10 CONTINUE
      RETURN
      END