LAPACK: BLAS/SRC/sasum.f Source File

Go to the documentation of this file.
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) GO TO 20
00035 *
00036 *        code for increment not equal to 1
00037 *
00038       NINCX = N*INCX
00039       DO 10 I = 1,NINCX,INCX
00040           STEMP = STEMP + ABS(SX(I))
00041    10 CONTINUE
00042       SASUM = STEMP
00043       RETURN
00044 *
00045 *        code for increment equal to 1
00046 *
00047 *
00048 *        clean-up loop
00049 *
00050    20 M = MOD(N,6)
00051       IF (M.EQ.0) GO TO 40
00052       DO 30 I = 1,M
00053           STEMP = STEMP + ABS(SX(I))
00054    30 CONTINUE
00055       IF (N.LT.6) GO TO 60
00056    40 MP1 = M + 1
00057       DO 50 I = MP1,N,6
00058           STEMP = STEMP + ABS(SX(I)) + ABS(SX(I+1)) + ABS(SX(I+2)) +
00059      +            ABS(SX(I+3)) + ABS(SX(I+4)) + ABS(SX(I+5))
00060    50 CONTINUE
00061    60 SASUM = STEMP
00062       RETURN
00063       END