summaryrefslogtreecommitdiff
path: root/SRC/sla_wwaddw.f
blob: 16d1fdd23a4911cee0be574a241e663c20b83174 (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 SLA_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 ..
      REAL               X( * ), Y( * ), W( * )
*     ..
*
*     Purpose
*     =======
*
*     SLA_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) REAL array, dimension (N)
*            The first part of the doubled-single accumulation vector.
*
*     Y      (input/output) REAL array, dimension (N)
*            The second part of the doubled-single accumulation vector.
*
*     W      (input) REAL array, dimension (N)
*            The vector to be added.
*
*  =====================================================================
*
*     .. Local Scalars ..
      REAL               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