← Back to branch summary

~ubuntu-branches/debian/sid/octave3.0/sid

« back to all changes in this revision

Viewing changes to libcruft/blas/dasum.f

  • Committer: Bazaar Package Importer
  • Author(s): Rafael Laboissiere
  • Date: 2007-12-23 16:04:15 UTC
  • Revision ID: james.westby@ubuntu.com-20071223160415-n4gk468dihy22e9v
Tags: upstream-3.0.0
Import upstream version 3.0.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
libcruft/blas/dasum.f
 
1
      double precision function dasum(n,dx,incx)
 
2
c
 
3
c     takes the sum of the absolute values.
 
4
c     jack dongarra, linpack, 3/11/78.
 
5
c     modified 3/93 to return if incx .le. 0.
 
6
c     modified 12/3/93, array(1) declarations changed to array(*)
 
7
c
 
8
      double precision dx(*),dtemp
 
9
      integer i,incx,m,mp1,n,nincx
 
10
c
 
11
      dasum = 0.0d0
 
12
      dtemp = 0.0d0
 
13
      if( n.le.0 .or. incx.le.0 )return
 
14
      if(incx.eq.1)go to 20
 
15
c
 
16
c        code for increment not equal to 1
 
17
c
 
18
      nincx = n*incx
 
19
      do 10 i = 1,nincx,incx
 
20
        dtemp = dtemp + dabs(dx(i))
 
21
   10 continue
 
22
      dasum = dtemp
 
23
      return
 
24
c
 
25
c        code for increment equal to 1
 
26
c
 
27
c
 
28
c        clean-up loop
 
29
c
 
30
   20 m = mod(n,6)
 
31
      if( m .eq. 0 ) go to 40
 
32
      do 30 i = 1,m
 
33
        dtemp = dtemp + dabs(dx(i))
 
34
   30 continue
 
35
      if( n .lt. 6 ) go to 60
 
36
   40 mp1 = m + 1
 
37
      do 50 i = mp1,n,6
 
38
        dtemp = dtemp + dabs(dx(i)) + dabs(dx(i + 1)) + dabs(dx(i + 2))
 
39
     *  + dabs(dx(i + 3)) + dabs(dx(i + 4)) + dabs(dx(i + 5))
 
40
   50 continue
 
41
   60 dasum = dtemp
 
42
      return
 
43
      end