diff options
| author | julie <julielangou@users.noreply.github.com> | 2008-12-16 17:06:58 +0000 |
|---|---|---|
| committer | julie <julielangou@users.noreply.github.com> | 2008-12-16 17:06:58 +0000 |
| commit | ff981f106bde4ce6a74aa4f4a572c943f5a395b2 (patch) | |
| tree | a386cad907bcaefd6893535c31d67ec9468e693e /SRC/cla_wwaddw.f | |
| parent | e58b61578b55644f6391f3333262b72c1dc88437 (diff) | |
| download | lapack-ff981f106bde4ce6a74aa4f4a572c943f5a395b2.tar.gz lapack-ff981f106bde4ce6a74aa4f4a572c943f5a395b2.tar.bz2 lapack-ff981f106bde4ce6a74aa4f4a572c943f5a395b2.zip | |
Diffstat (limited to 'SRC/cla_wwaddw.f')
| -rw-r--r-- | SRC/cla_wwaddw.f | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/SRC/cla_wwaddw.f b/SRC/cla_wwaddw.f new file mode 100644 index 00000000..d0a7e88f --- /dev/null +++ b/SRC/cla_wwaddw.f @@ -0,0 +1,53 @@ + SUBROUTINE CLA_WWADDW( N, X, Y, W ) +* +* -- LAPACK routine (version 3.2) -- +* -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and -- +* -- Jason Riedy of Univ. of California Berkeley. -- +* -- November 2008 -- +* +* -- 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, Y (input/output) COMPLEX array, length N +* The doubled-single accumulation vector. +* +* W (input) COMPLEX array, length 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 |