diff options
| author | jason <jason@8a072113-8704-0410-8d35-dd094bca7971> | 2008-10-28 01:38:50 +0000 |
|---|---|---|
| committer | jason <jason@8a072113-8704-0410-8d35-dd094bca7971> | 2008-10-28 01:38:50 +0000 |
| commit | baba851215b44ac3b60b9248eb02bcce7eb76247 (patch) | |
| tree | 8c0f5c006875532a30d4409f5e94b0f310ff00a7 /BLAS/SRC/scasum.f | |
| download | lapack-baba851215b44ac3b60b9248eb02bcce7eb76247.tar.gz lapack-baba851215b44ac3b60b9248eb02bcce7eb76247.tar.bz2 lapack-baba851215b44ac3b60b9248eb02bcce7eb76247.zip | |
Move LAPACK trunk into position.
Diffstat (limited to 'BLAS/SRC/scasum.f')
| -rw-r--r-- | BLAS/SRC/scasum.f | 47 |
1 files changed, 47 insertions, 0 deletions
diff --git a/BLAS/SRC/scasum.f b/BLAS/SRC/scasum.f new file mode 100644 index 00000000..5a4abfa9 --- /dev/null +++ b/BLAS/SRC/scasum.f @@ -0,0 +1,47 @@ + REAL FUNCTION SCASUM(N,CX,INCX) +* .. Scalar Arguments .. + INTEGER INCX,N +* .. +* .. Array Arguments .. + COMPLEX CX(*) +* .. +* +* Purpose +* ======= +* +* takes the sum of the absolute values of a complex vector and +* returns a single precision result. +* jack dongarra, linpack, 3/11/78. +* modified 3/93 to return if incx .le. 0. +* modified 12/3/93, array(1) declarations changed to array(*) +* +* +* .. Local Scalars .. + REAL STEMP + INTEGER I,NINCX +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS,AIMAG,REAL +* .. + SCASUM = 0.0e0 + STEMP = 0.0e0 + IF (N.LE.0 .OR. INCX.LE.0) RETURN + IF (INCX.EQ.1) GO TO 20 +* +* code for increment not equal to 1 +* + NINCX = N*INCX + DO 10 I = 1,NINCX,INCX + STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I))) + 10 CONTINUE + SCASUM = STEMP + RETURN +* +* code for increment equal to 1 +* + 20 DO 30 I = 1,N + STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I))) + 30 CONTINUE + SCASUM = STEMP + RETURN + END |