#pragma -xO
      program whets

      implicit real*32 (a-h, o-z)
c
      common t, t1, t2, e1(4), j, k, l
      integer time0, time1
c
      time0 = 0
      call cputyd(time0)
c
      t = 0.499975
      t1 = 0.50025
      t2 = 2.0
c
c     with iweigh=10, one million whetstone instructions
c     will be executed in each major loop.a major loop is executed
c     'ii' times to increase wall-clock timing accuracy.
c
      iweigh = 10
      ii   = 10
c
      do 500 jj=1, ii
      n1 = 0
      n2 = 12 * iweigh
      n3 = 14 * iweigh
      n4 = 345 * iweigh
      n5 = 0
      n6 = 210 * iweigh
      n7 = 32 * iweigh
      n8 = 899 * iweigh
      n9 = 616 * iweigh
      n10 = 0
      n11 = 93 * iweigh
c
c     module 1: simple identifiers
c
      x1 = 1.0
      x2 = -1.0
      x3 = -1.0
      x4 = -1.0
c
      do 30 i=1, n1
        x1 = (x1 + x2 + x3 - x4)*t
        x2 = (x1 + x2 - x3 + x4)*t
        x3 = (x1 - x2 + x3 + x4)*t
        x4 = (-x1 + x2 + x3 + x4)*t
   30 continue
c
      if (jj .eq. ii) call pout(n1, n1, n1, x1, x2, x3, x4)
c
c     module 2: array elements
c
      e1(1) = 1.0
      e1(2) = -1.0
      e1(3) = -1.0
      e1(4) = -1.0
c
      do 40 i=1, n2
         e1(1) = (e1(1) + e1(2) + e1(3) - e1(4))*t
         e1(2) = (e1(1) + e1(2) - e1(3) + e1(4))*t
         e1(3) = (e1(1) - e1(2) + e1(3) + e1(4))*t
         e1(4) = (-e1(1) + e1(2) + e1(3) + e1(4))*t
   40 continue
c
      if (jj .eq. ii) call pout(n2, n3, n2, e1(1), e1(2), e1(3), e1(4))
c
c     module 3: array as parameter
c
      do 50 i=1, n3
        call pa(e1)
   50 continue
c
      if (jj .eq. ii) call pout(n3, n2, n2, e1(1), e1(2), e1(3), e1(4))
c
c     module 4: conditional jumps
c
      j = 1
      do 60 i=1, n4
         if (j .eq. 1) go to 51
         j = 3
         go to 52
51       j = 2
52       if (j .gt. 2) go to 53
         j = 1
         go to 54
53       j = 0
54       if (j .lt. 1) go to 55
         j = 0
         go to 60
55       j = 1
   60 continue
c
      if (jj .eq. ii) call pout(n4, j, j, x1, x2, x3, x4)
c
c     module 5: omitted
c     module 6: integer arithmetic
c        
      j = 1
      k = 2
      l = 3
c
      do 70 i=1, n6
         j = j * (k-j) * (l-k)
         k = l * k - (l-j) * k
         l = (l - k) * (k + j)
         e1(l-1) = j + k + l
         e1(k-1) = j * k * l
   70 continue
c
      if (jj .eq. ii) call pout(n6, j, k, e1(1), e1(2), e1(3), e1(4))
c
c     module 7: trigonometric functions
c
      x = 0.5
      y = 0.5
c
      do 80 i=1, n7
        x = t * atan(t2 * sin(x) * cos(x) / 
     .      (cos(x + y) + cos(x - y) - 1.0x0))
        y = t * atan(t2 * sin(y) * cos(y) /
     .      (cos(x + y) + cos(x - y) - 1.0x0))
   80 continue
c
      if (jj .eq. ii) call pout(n7, j, k, x, x, y, y)
c
c    module 8: procedure calls
c
      x = 1.0
      y = 1.0
      z = 1.0
c
      do 90 i=1, n8
         call p3(x, y, z)
   90 continue
c
      if (jj .eq. ii) call pout(n8, j, k, x, y, z, z)
c
c     module 9: array references
c
      j = 1
      k = 2
      l = 3
      e1(1) = 1.0
      e1(2) = 2.0
      e1(3) = 3.0
c
      do 100 i=1, n9
         call p0
  100 continue
c
      if (jj .eq. ii) call pout(n9, j, k, e1(1), e1(2), e1(3), e1(4))
c
c     module 10: integer arithmetic
c
      j = 2
      k = 3
c
      do 110 i=1, n10
         j = j + k
         k = j + k
         j = k - j
         k = k - j - j
  110 continue
c
      if (jj .eq. ii) call pout(n10, j, k, x1, x2, x3, x4)
c
c     module 11: standard functions
c
      x = 0.75
c
      do 120 i=1, n11
         x = sqrt(exp(log(x)/t1))
  120 continue
c
      if (jj .eq. ii) call pout(n11, j, k, x, x, x, x)
c
500   continue
c
      call cputyd (time1)
      write (6, 1) 10000 * (iweigh / 10 * ii) / dble (time1-time0)
    1 format (x, f9.1, ' mwhets')
      end
c
      subroutine pa(e)
      implicit real*32 (a-h, o-z)
      dimension e(4)
      common t, t1, t2, e1(4), j, k, l
      j1 = 0
   10 e(1) = (e(1) + e(2) + e(3) - e(4)) * t
      e(2) = (e(1) + e(2) - e(3) + e(4)) * t  
      e(3) = (e(1) - e(2) + e(3) + e(4)) * t
      e(4) = (-e(1) + e(2) + e(3) + e(4)) / t2
      j1 = j1 + 1
      if (j1 - 6) 10, 20, 20
   20 return
      end
c
      subroutine p0
      implicit real*32 (a-h, o-z)
      common t, t1, t2, e1(4), j, k, l
      e1(j) = e1(k)
      e1(k) = e1(l)
      e1(l) = e1(j)
      return
      end
c
      subroutine p3(x, y, z)
      implicit real*32 (a-h, o-z)
      common t, t1, t2, e1(4), j, k, l
      x1 = x
      y1 = y
      x1 = t * (x1 + y1)
      y1 = t * (x1 + y1)
      z = (x1 + y1) / t2
      return
      end
c
      subroutine pout(n, j, k, x1, x2, x3, x4)
      implicit real*32 (a-h, o-z)
      write (6, 10) n, j, k, x1, x2, x3, x4
   10 format (3(x, i7), 4(x, e12.4))
      return
      end
