Logo Search packages:      
Sourcecode: r-cran-vgam version File versions  Download package

vlinpack3.f

c 1/4/00 
c The following code is linpack.f from GAMFIT
c For R.1.0-0, subroutine dshift is needed 

c 12/7/02; T.Yee
c I























































































































've modifed the routines in this file so that reals become double c precisions. The subroutine and functions may have a "8" put after itc to (hopefully) make it unique.c All this for the VGAM package.c For example, "real function ddot" to "double precision function ddot8".c I might add a "implicit logical (a-z)" line to pick up errors.      subroutine daxpy8(n,da,dx,incx,dy,incy)      implicit logical (a-z) cc     constant times a vector plus a vector.c     uses unrolled loops for increments equal to one.c     jack dongarra, linpack, 3/11/78.c      double precision dx(1),dy(1),da      integer          i,incx,incy,m,mp1,nc Undeclared, so added by T.Yee      integer          ix, iyc      if(n.le.0)return      if (da .eq. 0.0d0) return      if(incx.eq.1.and.incy.eq.1)go to 20cc        code for unequal increments or equal incrementsc          not equal to 1c      ix = 1      iy = 1      if(incx.lt.0)ix = (-n+1)*incx + 1      if(incy.lt.0)iy = (-n+1)*incy + 1      do 10 i = 1,n        dy(iy) = dy(iy) + da*dx(ix)        ix = ix + incx        iy = iy + incy   10 continue      returncc        code for both increments equal to 1ccc        clean-up loopc   20 m = mod(n,4)      if( m .eq. 0 ) go to 40      do 30 i = 1,m        dy(i) = dy(i) + da*dx(i)   30 continue      if( n .lt. 4 ) return   40 mp1 = m + 1      do 50 i = mp1,n,4        dy(i) = dy(i) + da*dx(i)        dy(i + 1) = dy(i + 1) + da*dx(i + 1)        dy(i + 2) = dy(i + 2) + da*dx(i + 2)        dy(i + 3) = dy(i + 3) + da*dx(i + 3)   50 continue      return      end      subroutine  dcopy8(n,dx,incx,dy,incy)      implicit logical (a-z) cc     copies a vector, x, to a vector, y.c     uses unrolled loops for increments equal to one.c     jack dongarra, linpack, 3/11/78.c      double precision dx(1),dy(1)      integer i,incx,incy,ix,iy,m,mp1,nc      if(n.le.0)return      if(incx.eq.1.and.incy.eq.1)go to 20cc        code for unequal increments or equal incrementsc          not equal to 1c      ix = 1      iy = 1      if(incx.lt.0)ix = (-n+1)*incx + 1      if(incy.lt.0)iy = (-n+1)*incy + 1      do 10 i = 1,n        dy(iy) = dx(ix)        ix = ix + incx        iy = iy + incy   10 continue      returncc        code for both increments equal to 1ccc        clean-up loopc   20 m = mod(n,7)      if( m .eq. 0 ) go to 40      do 30 i = 1,m        dy(i) = dx(i)   30 continue      if( n .lt. 7 ) return   40 mp1 = m + 1      do 50 i = mp1,n,7        dy(i) = dx(i)        dy(i + 1) = dx(i + 1)        dy(i + 2) = dx(i + 2)        dy(i + 3) = dx(i + 3)        dy(i + 4) = dx(i + 4)        dy(i + 5) = dx(i + 5)        dy(i + 6) = dx(i + 6)   50 continue      return      end      double precision function ddot8(n,dx,incx,dy,incy)cc 12/7/02; T.Yeec I've modifed "real function ddot" to
c "double precision function ddot8" for the VGAM package
c I























































































































































































































































































































































































































































































































































Generated by  Doxygen 1.6.0   Back to index