osse/EnKF/sasum.F

      real function sasum(n,sx,incx)
c
c     takes the sum of the absolute values.
c     uses unrolled loops for increment equal to one.
c     jack dongarra, linpack, 3/11/78.
c     modified 3/93 to return if incx .le. 0.
c
      real sx(1),stemp
      integer i,incx,m,mp1,n,nincx
c
      sasum = 0.00
      stemp = 0.00
      if( n.le.0 .or. incx.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
        stemp = stemp + abs(sx(i))
   10 continue
      sasum = stemp
      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
        stemp = stemp + abs(sx(i))
   30 continue
      if( n .lt. 6 ) go to 60
   40 mp1 = m + 1
      do 50 i = mp1,n,6
        stemp = stemp + abs(sx(i)) + abs(sx(i + 1)) + abs(sx(i + 2))
     *  + abs(sx(i + 3)) + abs(sx(i + 4)) + abs(sx(i + 5))
   50 continue
   60 sasum = stemp
      return
      end
1	real function sasum(n,sx,incx)
2	c
3	c takes the sum of the absolute values.
4	c uses unrolled loops for increment equal to one.
5	c jack dongarra, linpack, 3/11/78.
6	c modified 3/93 to return if incx .le. 0.
7	c
8	real sx(1),stemp
9	integer i,incx,m,mp1,n,nincx
10	c
11	sasum = 0.00
12	stemp = 0.00
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	stemp = stemp + abs(sx(i))
21	10 continue
22	sasum = stemp
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	stemp = stemp + abs(sx(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	stemp = stemp + abs(sx(i)) + abs(sx(i + 1)) + abs(sx(i + 2))
39	* + abs(sx(i + 3)) + abs(sx(i + 4)) + abs(sx(i + 5))
40	50 continue
41	60 sasum = stemp
42	return
43	end