--- rpl/lapack/blas/dasum.f 2010/12/21 13:51:24 1.6 +++ rpl/lapack/blas/dasum.f 2017/06/17 10:53:42 1.13 @@ -1,4 +1,61 @@ +*> \brief \b DASUM +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX) +* +* .. Scalar Arguments .. +* INTEGER INCX,N +* .. +* .. Array Arguments .. +* DOUBLE PRECISION DX(*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DASUM takes the sum of the absolute values. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date December 2016 +* +*> \ingroup double_blas_level1 +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> 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(*) +*> \endverbatim +*> +* ===================================================================== DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX) +* +* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* December 2016 +* * .. Scalar Arguments .. INTEGER INCX,N * .. @@ -6,18 +63,6 @@ DOUBLE PRECISION DX(*) * .. * -* Purpose -* ======= -* -* DASUM takes the sum of the absolute values. -* -* Further Details -* =============== -* -* 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 .. @@ -30,33 +75,37 @@ DASUM = 0.0d0 DTEMP = 0.0d0 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 - DTEMP = DTEMP + DABS(DX(I)) - 10 CONTINUE - DASUM = DTEMP - RETURN -* + IF (INCX.EQ.1) THEN * code for increment equal to 1 * * * clean-up loop * - 20 M = MOD(N,6) - IF (M.EQ.0) GO TO 40 - DO 30 I = 1,M - DTEMP = DTEMP + DABS(DX(I)) - 30 CONTINUE - IF (N.LT.6) GO TO 60 - 40 MP1 = M + 1 - DO 50 I = MP1,N,6 - DTEMP = DTEMP + DABS(DX(I)) + DABS(DX(I+1)) + DABS(DX(I+2)) + - + DABS(DX(I+3)) + DABS(DX(I+4)) + DABS(DX(I+5)) - 50 CONTINUE - 60 DASUM = DTEMP + M = MOD(N,6) + IF (M.NE.0) THEN + DO I = 1,M + DTEMP = DTEMP + DABS(DX(I)) + END DO + IF (N.LT.6) THEN + DASUM = DTEMP + RETURN + END IF + END IF + MP1 = M + 1 + DO I = MP1,N,6 + DTEMP = DTEMP + DABS(DX(I)) + DABS(DX(I+1)) + + $ DABS(DX(I+2)) + DABS(DX(I+3)) + + $ DABS(DX(I+4)) + DABS(DX(I+5)) + END DO + ELSE +* +* code for increment not equal to 1 +* + NINCX = N*INCX + DO I = 1,NINCX,INCX + DTEMP = DTEMP + DABS(DX(I)) + END DO + END IF + DASUM = DTEMP RETURN END