 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 REAL FUNCTION SASUM(N,SX,INCX) 00002 * .. Scalar Arguments .. 00003 INTEGER INCX,N 00004 * .. 00005 * .. Array Arguments .. 00006 REAL SX(*) 00007 * .. 00008 * 00009 * Purpose 00010 * ======= 00011 * 00012 * SASUM takes the sum of the absolute values. 00013 * uses unrolled loops for increment equal to one. 00014 * 00015 * Further Details 00016 * =============== 00017 * 00018 * jack dongarra, linpack, 3/11/78. 00019 * modified 3/93 to return if incx .le. 0. 00020 * modified 12/3/93, array(1) declarations changed to array(*) 00021 * 00022 * ===================================================================== 00023 * 00024 * .. Local Scalars .. 00025 REAL STEMP 00026 INTEGER I,M,MP1,NINCX 00027 * .. 00028 * .. Intrinsic Functions .. 00029 INTRINSIC ABS,MOD 00030 * .. 00031 SASUM = 0.0e0 00032 STEMP = 0.0e0 00033 IF (N.LE.0 .OR. INCX.LE.0) RETURN 00034 IF (INCX.EQ.1) THEN 00035 * code for increment equal to 1 00036 * 00037 * 00038 * clean-up loop 00039 * 00040 M = MOD(N,6) 00041 IF (M.NE.0) THEN 00042 DO I = 1,M 00043 STEMP = STEMP + ABS(SX(I)) 00044 END DO 00045 IF (N.LT.6) THEN 00046 SASUM = STEMP 00047 RETURN 00048 END IF 00049 END IF 00050 MP1 = M + 1 00051 DO I = MP1,N,6 00052 STEMP = STEMP + ABS(SX(I)) + ABS(SX(I+1)) + 00053 $ ABS(SX(I+2)) + ABS(SX(I+3)) + 00054 $ ABS(SX(I+4)) + ABS(SX(I+5)) 00055 END DO 00056 ELSE 00057 * 00058 * code for increment not equal to 1 00059 * 00060 NINCX = N*INCX 00061 DO I = 1,NINCX,INCX 00062 STEMP = STEMP + ABS(SX(I)) 00063 END DO 00064 END IF 00065 SASUM = STEMP 00066 RETURN 00067 END
1.7.3 
