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