********************************************************************************
*                                                                              *
*  2DHF version 1-2003                                                         *
*  Copyright (C) 1996  Jacek Kobus, Leif Laaksonen, Dage Sundholm              *
*                                                                              *
*  This software may be used and distributed according to the terms            *
*  of the GNU General Public License, see README and COPYING.                  *
*                                                                              *
********************************************************************************
c ### blas ###
c
c     Replacement for BLAS routines: dcopy, daxpy, dscal, ddot, mxv
c
      subroutine  dcopy(n,dx,ix,dy,iy)
      real*8  dx(*),dy(*)
      integer*4 i,ix,iy,n
      
      do i=1,n
         dy(i)=dx(i)
      enddo
      return
      end

      subroutine  daxpy(n,da,dx,ix,dy,iy)
      real*8 da,dx(*),dy(*)
      integer*4  i,ix,iy,n

      do i=1,n
         dy(i)=da*dx(i)+dy(i)
      enddo
      return
      end

      subroutine  dscal(n,da,dx,ix)
      real*8 da,dx(*)
      integer*4 i,ix,n

      do i=1,n
         dx(i)=da*dx(i)
      enddo
      return
      end

      function  ddot(n,dx,ix,dy,iy)
      real*8  dx(*),dy(*),ddot
      integer*4  i,ix,iy,n

      ddot=0.d0
      do i=1,n
         ddot=ddot+dx(i)*dy(i)
      enddo
      return
      end

      subroutine  mxv (dx,nr,dv,nc,dvr)

c     Routine multiplying the matrix DX(NR,NC) times the vector DV(NC) and
c     storing the result in the vector DVR(NR)

      real*8  dx(nr,nc),dv(nc),dvr(nr),s
      integer*4  nr,nc,nh,inr,inc

      do inr=1,nr
         s=0.d0
         do inc=1,nc
            s=s+dx(inr,inc)*dv(inc)
         enddo
         dvr(inr)=s
      enddo
      return
      end