|
|
1.1 ! root 1: real function sdot(n,sx,incx,sy,incy) ! 2: c ! 3: c forms the dot product of two vectors. ! 4: c uses unrolled loops for increments equal to one. ! 5: c jack dongarra, linpack, 3/11/78. ! 6: c ! 7: real sx(1),sy(1),stemp ! 8: integer i,incx,incy,ix,iy,m,mp1,n ! 9: c ! 10: stemp = 0.0e0 ! 11: sdot = 0.0e0 ! 12: if(n.le.0)return ! 13: if(incx.eq.1.and.incy.eq.1)go to 20 ! 14: c ! 15: c code for unequal increments or equal increments ! 16: c not equal to 1 ! 17: c ! 18: ix = 1 ! 19: iy = 1 ! 20: if(incx.lt.0)ix = (-n+1)*incx + 1 ! 21: if(incy.lt.0)iy = (-n+1)*incy + 1 ! 22: do 10 i = 1,n ! 23: stemp = stemp + sx(ix)*sy(iy) ! 24: ix = ix + incx ! 25: iy = iy + incy ! 26: 10 continue ! 27: sdot = stemp ! 28: return ! 29: c ! 30: c code for both increments equal to 1 ! 31: c ! 32: c ! 33: c clean-up loop ! 34: c ! 35: 20 m = mod(n,5) ! 36: if( m .eq. 0 ) go to 40 ! 37: do 30 i = 1,m ! 38: stemp = stemp + sx(i)*sy(i) ! 39: 30 continue ! 40: if( n .lt. 5 ) go to 60 ! 41: 40 mp1 = m + 1 ! 42: do 50 i = mp1,n,5 ! 43: stemp = stemp + sx(i)*sy(i) + sx(i + 1)*sy(i + 1) + ! 44: * sx(i + 2)*sy(i + 2) + sx(i + 3)*sy(i + 3) + sx(i + 4)*sy(i + 4) ! 45: 50 continue ! 46: 60 sdot = stemp ! 47: return ! 48: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.