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	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