trunk/blas/dasum.f

C  dasum.f
C  is freely available from netlib. It is not subject to any GNU License
C  set by the authors of the ASCEND math programming system.
C  $Date: 1996/04/30 18:14:07 $ $Revision: 1.1.1.1 $
C
      double precision function dasum(n,dx,incx)
c
c     takes the sum of the absolute values.
c     jack dongarra, linpack, 3/11/78.
c
      double precision dx(*),dtemp
      integer i,incx,m,mp1,n,nincx
c
      dasum = 0.0d0
      dtemp = 0.0d0
      if(n.le.0)return
      if(incx.eq.1)go to 20
c
c        code for increment not equal to 1
c
      nincx = n*incx
      do 10 i = 1,nincx,incx
        dtemp = dtemp + dabs(dx(i))
   10 continue
      dasum = dtemp
      return
c
c        code for increment equal to 1
c
c
c        clean-up loop
c
   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
      return
      end

1	aw0a	1	C dasum.f
2			C is freely available from netlib. It is not subject to any GNU License
3			C set by the authors of the ASCEND math programming system.
4			C $Date: 1996/04/30 18:14:07 $ $Revision: 1.1.1.1 $
5			C
6			double precision function dasum(n,dx,incx)
7			c
8			c takes the sum of the absolute values.
9			c jack dongarra, linpack, 3/11/78.
10			c
11			double precision dx(*),dtemp
12			integer i,incx,m,mp1,n,nincx
13			c
14			dasum = 0.0d0
15			dtemp = 0.0d0
16			if(n.le.0)return
17			if(incx.eq.1)go to 20
18			c
19			c code for increment not equal to 1
20			c
21			nincx = n*incx
22			do 10 i = 1,nincx,incx
23			dtemp = dtemp + dabs(dx(i))
24			10 continue
25			dasum = dtemp
26			return
27			c
28			c code for increment equal to 1
29			c
30			c
31			c clean-up loop
32			c
33			20 m = mod(n,6)
34			if( m .eq. 0 ) go to 40
35			do 30 i = 1,m
36			dtemp = dtemp + dabs(dx(i))
37			30 continue
38			if( n .lt. 6 ) go to 60
39			40 mp1 = m + 1
40			do 50 i = mp1,n,6
41			dtemp = dtemp + dabs(dx(i)) + dabs(dx(i + 1)) + dabs(dx(i + 2))
42			* + dabs(dx(i + 3)) + dabs(dx(i + 4)) + dabs(dx(i + 5))
43			50 continue
44			60 dasum = dtemp
45			return
46			end
47