#pragma -xO
      implicit none
      parameter (n = 1000)
      parameter (lda = n + 1)
      integer k, lda, i, info, in, ipvt(n)
      real*8 a(lda, n), b(n), cray, eps, epslon
      real*8 norma, normx, ops, resid, residn, t1, t2, time(6), total, x(n)
      write (*, '(a)') 'linpack_bench_d'
      write (*, '(a)') '  the linpack benchmark.'
      write (*, '(a)') '  language: fortran77'
      write (*, '(a)') '  datatype: real real*8'
      write (*, '(a, i8)') '  matrix order n =               ', n
      write (*, '(a, i8)') '  leading matrix dimension lda = ', lda
      cray = .056
      ops = (2.0d0*dfloat(n)**3)/3.0d0 + 2.0d0*dfloat(n)**2
      do k =1, 10
         call matgen(a, lda, n, b, norma)
         call cputim (t1)
         call dgefa(a, lda, n, ipvt, info)
         call cputim (t2)
         time(1) = t2 - t1
         call cputim (t1)
         call dgesl(a, lda, n, ipvt, b, 0)
         call cputim (t2)
         time(2) = t2 - t1
         total = time(1) + time(2)
         do i = 1, n
            x(i) = b(i)
         end do
         call matgen(a, lda, n, b, norma)
         do i = 1, n
            b(i) = -b(i)
         end do
         call dmxpy(n, b, n, lda, x, a)
         resid = 0.0
         normx = 0.0
         do i = 1, n
            resid = dmax1(resid, dabs(b(i)))
            normx = dmax1(normx, dabs(x(i)))
         end do
         eps = epslon(1.0d0)
         residn = resid/(n*norma*normx*eps)
         write(6, 40)
   40    format('     norm. resid resid machep', 
     $          '         x(1)          x(n)')
         write(6, 50) residn, resid, eps, x(1), x(n)
   50    format(5(1pe16.8))
         write(6, 70)
   70    format(6x, 'factor', 5x, 'solve', 6x, 'total', 5x, 'mflops', 7x, 'unit', 
     $         6x, 'ratio')
         time(3) = total
         time(4) = ops/(1.0d6*total)
         time(5) = 2.0d0/time(4)
         time(6) = total/cray
         write(6, 110) (time(i), i=1, 6)
  110    format(6(1pe11.3))
      end do
      end

      subroutine matgen(a, lda, n, b, norma)
      integer lda, n, init(4), i, j
      real*8 a(lda, 1), b(1), norma, random_value
      init(1) = 1
      init(2) = 2
      init(3) = 3
      init(4) = 1325
      norma = 0.0
      do 30 j = 1, n
         do 20 i = 1, n
            a(i, j) = random_value(init) - .5
            norma = dmax1(dabs(a(i, j)), norma)
   20    continue
   30 continue
      do 35 i = 1, n
          b(i) = 0.0
   35 continue
      do 50 j = 1, n
         do 40 i = 1, n
            b(i) = b(i) + a(i, j)
   40    continue
   50 continue
      return
      end

      subroutine dgefa(a, lda, n, ipvt, info)
      integer lda, n, ipvt(1), info
      real*8 a(lda, 1)
      real*8 t
      integer idamax, j, k, kp1, l, nm1
      info = 0
      nm1 = n - 1
      if (nm1 .lt. 1) go to 70
      do 60 k = 1, nm1
         kp1 = k + 1
         l = idamax(n-k+1, a(k, k), 1) + k - 1
         ipvt(k) = l
         if (a(l, k) .eq. 0.0d0) go to 40
            if (l .eq. k) go to 10
               t = a(l, k)
               a(l, k) = a(k, k)
               a(k, k) = t
   10       continue
            t = -1.0d0/a(k, k)
            call dscal(n-k, t, a(k+1, k), 1)
            do 30 j = kp1, n
               t = a(l, j)
               if (l .eq. k) go to 20
                  a(l, j) = a(k, j)
                  a(k, j) = t
   20          continue
               call daxpy(n-k, t, a(k+1, k), 1, a(k+1, j), 1)
   30       continue
         go to 50
   40    continue
            info = k
   50    continue
   60 continue
   70 continue
      ipvt(n) = n
      if (a(n, n) .eq. 0.0d0) info = n
      return
      end

      subroutine dgesl(a, lda, n, ipvt, b, job)
      integer lda, n, ipvt(1), job
      real*8 a(lda, 1), b(1)
      real*8 ddot, t
      integer k, kb, l, nm1
      nm1 = n - 1
      if (job .ne. 0) go to 50
         if (nm1 .lt. 1) go to 30
         do 20 k = 1, nm1
            l = ipvt(k)
            t = b(l)
            if (l .eq. k) go to 10
               b(l) = b(k)
               b(k) = t
   10       continue
            call daxpy(n-k, t, a(k+1, k), 1, b(k+1), 1)
   20    continue
   30    continue
         do 40 kb = 1, n
            k = n + 1 - kb
            b(k) = b(k)/a(k, k)
            t = -b(k)
            call daxpy(k-1, t, a(1, k), 1, b(1), 1)
   40    continue
      go to 100
   50 continue
         do 60 k = 1, n
            t = ddot(k-1, a(1, k), 1, b(1), 1)
            b(k) = (b(k) - t)/a(k, k)
   60    continue
         if (nm1 .lt. 1) go to 90
         do 80 kb = 1, nm1
            k = n - kb
            b(k) = b(k) + ddot(n-k, a(k+1, k), 1, b(k+1), 1)
            l = ipvt(k)
            if (l .eq. k) go to 70
               t = b(l)
               b(l) = b(k)
               b(k) = t
   70       continue
   80    continue
   90    continue
  100 continue
      return
      end

      subroutine daxpy(n, da, dx, incx, dy, incy)
      real*8 dx(1), dy(1), da
      integer i, incx, incy, ix, iy, m, mp1, n
      if(n.le.0)return
      if (da .eq. 0.0d0) return
      if(incx.eq.1.and.incy.eq.1)go to 20
      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
      return
   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

      real*8 function ddot(n, dx, incx, dy, incy)
      real*8 dx(1), dy(1), dtemp
      integer i, incx, incy, ix, iy, m, mp1, n
      ddot = 0.0d0
      dtemp = 0.0d0
      if(n.le.0)return
      if(incx.eq.1.and.incy.eq.1)go to 20
      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
        dtemp = dtemp + dx(ix)*dy(iy)
        ix = ix + incx
        iy = iy + incy
   10 continue
      ddot = dtemp
      return
   20 m = mod(n, 5)
      if(m .eq. 0) go to 40
      do 30 i = 1, m
        dtemp = dtemp + dx(i)*dy(i)
   30 continue
      if(n .lt. 5) go to 60
   40 mp1 = m + 1
      do 50 i = mp1, n, 5
        dtemp = dtemp + dx(i)*dy(i) + dx(i + 1)*dy(i + 1) +
     *   dx(i + 2)*dy(i + 2) + dx(i + 3)*dy(i + 3) + dx(i + 4)*dy(i + 4)
   50 continue
   60 ddot = dtemp
      return
      end

      subroutine dscal(n, da, dx, incx)
      real*8 da, dx(1)
      integer i, incx, m, mp1, n, nincx
      if(n.le.0)return
      if(incx.eq.1)go to 20
      nincx = n*incx
      do 10 i = 1, nincx, incx
        dx(i) = da*dx(i)
   10 continue
      return
   20 m = mod(n, 5)
      if(m .eq. 0) go to 40
      do 30 i = 1, m
        dx(i) = da*dx(i)
   30 continue
      if(n .lt. 5) return
   40 mp1 = m + 1
      do 50 i = mp1, n, 5
        dx(i) = da*dx(i)
        dx(i + 1) = da*dx(i + 1)
        dx(i + 2) = da*dx(i + 2)
        dx(i + 3) = da*dx(i + 3)
        dx(i + 4) = da*dx(i + 4)
   50 continue
      return
      end

      integer function idamax(n, dx, incx)
      real*8 dx(1), dmax
      integer i, incx, ix, n
      idamax = 0
      if(n .lt. 1) return
      idamax = 1
      if(n.eq.1)return
      if(incx.eq.1)go to 20
      ix = 1
      dmax = dabs(dx(1))
      ix = ix + incx
      do 10 i = 2, n
         if(dabs(dx(ix)).le.dmax) go to 5
         idamax = i
         dmax = dabs(dx(ix))
    5    ix = ix + incx
   10 continue
      return
   20 dmax = dabs(dx(1))
      do 30 i = 2, n
         if(dabs(dx(i)).le.dmax) go to 30
         idamax = i
         dmax = dabs(dx(i))
   30 continue
      return
      end

      real*8 function epslon (x)
      real*8 x
      real*8 a, b, c, eps
      a = 4.0d0/3.0d0
   10 b = a - 1.0d0
      c = b + b + b
      eps = dabs(c-1.0d0)
      if (eps .eq. 0.0d0) go to 10
      epslon = eps*dabs(x)
      return
      end

      subroutine mm (a, lda, n1, n3, b, ldb, n2, c, ldc)
      real*8 a(lda, *), b(ldb, *), c(ldc, *)
      do 20 j = 1, n3
         do 10 i = 1, n1
            a(i, j) = 0.0
   10    continue
         call dmxpy (n2, a(1, j), n1, ldb, c(1, j), b)
   20 continue
      return
      end

      subroutine dmxpy (n1, y, n2, ldm, x, m)
      real*8 y(*), x(*), m(ldm, *)
      j = mod(n2, 2)
      if (j .ge. 1) then
         do 10 i = 1, n1
            y(i) = (y(i)) + x(j)*m(i, j)
   10    continue
      endif
      j = mod(n2, 4)
      if (j .ge. 2) then
         do 20 i = 1, n1
            y(i) = ((y(i))
     $             + x(j-1)*m(i, j-1)) + x(j)*m(i, j)
   20    continue
      endif
      j = mod(n2, 8)
      if (j .ge. 4) then
         do 30 i = 1, n1
            y(i) = ((((y(i))
     $             + x(j-3)*m(i, j-3)) + x(j-2)*m(i, j-2))
     $             + x(j-1)*m(i, j-1)) + x(j)  *m(i, j)
   30    continue
      endif
      j = mod(n2, 16)
      if (j .ge. 8) then
         do 40 i = 1, n1
            y(i) = ((((((((y(i))
     $             + x(j-7)*m(i, j-7)) + x(j-6)*m(i, j-6))
     $             + x(j-5)*m(i, j-5)) + x(j-4)*m(i, j-4))
     $             + x(j-3)*m(i, j-3)) + x(j-2)*m(i, j-2))
     $             + x(j-1)*m(i, j-1)) + x(j)  *m(i, j)
   40    continue
      endif
      jmin = j+16
      do 60 j = jmin, n2, 16
         do 50 i = 1, n1
            y(i) = ((((((((((((((((y(i))
     $             + x(j-15)*m(i, j-15)) + x(j-14)*m(i, j-14))
     $             + x(j-13)*m(i, j-13)) + x(j-12)*m(i, j-12))
     $             + x(j-11)*m(i, j-11)) + x(j-10)*m(i, j-10))
     $             + x(j- 9)*m(i, j- 9)) + x(j- 8)*m(i, j- 8))
     $             + x(j- 7)*m(i, j- 7)) + x(j- 6)*m(i, j- 6))
     $             + x(j- 5)*m(i, j- 5)) + x(j- 4)*m(i, j- 4))
     $             + x(j- 3)*m(i, j- 3)) + x(j- 2)*m(i, j- 2))
     $             + x(j- 1)*m(i, j- 1)) + x(j)   *m(i, j)
   50    continue
   60 continue
      return
      end

      real*8 function random_value(iseed)
      integer iseed(4)
      integer m1, m2, m3, m4
      parameter (m1 = 494, m2 = 322, m3 = 2508, m4 = 2549)
      real*8 one
      parameter (one = 1.0d+0)
      integer ipw2
      real*8 r
      parameter (ipw2 = 4096, r = one / ipw2)
      integer it1, it2, it3, it4
      intrinsic dble, mod
      it4 = iseed(4)*m4
      it3 = it4 / ipw2
      it4 = it4 - ipw2*it3
      it3 = it3 + iseed(3)*m4 + iseed(4)*m3
      it2 = it3 / ipw2
      it3 = it3 - ipw2*it2
      it2 = it2 + iseed(2)*m4 + iseed(3)*m3 + iseed(4)*m2
      it1 = it2 / ipw2
      it2 = it2 - ipw2*it1
      it1 = it1 + iseed(1)*m4 + iseed(2)*m3 + iseed(3)*m2 +
     $      iseed(4)*m1
      it1 = mod(it1, ipw2)
      iseed(1) = it1
      iseed(2) = it2
      iseed(3) = it3
      iseed(4) = it4
      random_value = r*(dble(it1)+r*(dble(it2)+r*(dble(it3)
     &  +r*(dble(it4)))))
      return
      end

