home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / Fortran.51 / DISK6 / DWHET.FO$ / DWHET.bin
Text File  |  1991-03-13  |  10KB  |  362 lines

  1. CC  DWHET.FOR - Double precision Whetstone program.
  2. CC              Measures FORTRAN and CPU performance in
  3. CC              Whetstone-instructions per second.
  4. CC
  5. CC
  6. CC              References on Whetstones:
  7. CC
  8. CC                        -  Computer Journal Feb 76
  9. CC                           pg 43-49 vol 19 no 1.
  10. CC                           Curnow and Wichmann.
  11. CC
  12. CC                        -  Timing Studies Using a
  13. CC                           Synthetic Whetstone Benchmark,
  14. CC                           S. Harbaugh & J. Forakris
  15. CC
  16. CC              References on FORTRAN Benchmarks:
  17. CC
  18. CC                        -  Computer Languages, Jan 1986
  19. CC                        -  EDN, Oct 3, 1985, Array Processors
  20. CC                           for PCs
  21. CC                        -  Byte, Feb 1984.
  22. CC
  23.  
  24.       INTEGER*4   j, k, l, i, isave
  25.       INTEGER*4   n2, n3, n4, n6, n7, n8, n9, n11
  26.       INTEGER*4   inner, outer, kount, npass, max_pass
  27.  
  28.       REAL*8      x, y, z, t1, t2, t3, e1(4)
  29.       REAL*8      whet_save, dif_save, kilowhet
  30.       REAL*8      begin_time, end_time, dif_time
  31.       REAL*8      error, whet_err, percent_err
  32.       REAL*8      secnds
  33.  
  34.       COMMON      t1, t2, t3, e1, j, k, l
  35.  
  36.  
  37. C
  38. C     Initialize pass-control variables.  DWHET must make at least
  39. C     two passes to calculate sensitivity terms.  NPASS counts passes;
  40. C     MAX_PASS is the maximum number of passes.  Currently the program
  41. C     is written such that MAX_PASS should have a value of 2.  For higher
  42. C     values of MAX_PASS, modifications to the program are required.
  43. C
  44.       npass    =    0
  45.       max_pass =    2
  46.  
  47.       WRITE (*,9000)
  48.       READ  (*,*) inner
  49.       WRITE (*,9100)
  50.       READ  (*,*) outer
  51.  
  52.       DO WHILE( npass .LT. max_pass)
  53.          WRITE (*,9200) npass + 1, outer, inner
  54.          WRITE (*,*) ('=', j = 1, 60)
  55.          kount      = 0
  56.          begin_time = secnds()
  57.  
  58. C
  59. C        Beginning of timed interval
  60. C
  61.  
  62.          DO WHILE( kount .LT. outer )
  63.  
  64. C
  65. C           Whetstone code begins here.  First initialize variables
  66. C           and loop counters based on the number of inner loops.
  67. C
  68. C           Loops 2 and 3 (described below) use variations of the
  69. C           following transformation statements:
  70. C
  71. C                  x1 = ( x1 + x2 + x3 - x4) * 0.5
  72. C                  x2 = ( x1 + x2 - x3 + x4) * 0.5
  73. C                  x3 = ( x1 - x2 + x3 + x4) * 0.5
  74. C                  x4 = (-x1 + x2 + x3 + x4) * 0.5
  75. C
  76. C           Theoretically this set tends to the solution
  77. C
  78. C                  x1 = x2 = x3 = x4 = 1.0
  79. C
  80. C           The variables t1, t2, and t3 are terms designed to limit
  81. C           convergence of the set.
  82. C
  83.             t1 = 0.499975D00
  84.             t2 = 0.50025D00
  85.             t3 = 2.0D00
  86.  
  87. C
  88. C           The variables n2-n11 are counters for Loops 2-11.
  89. C           Based on earlier statistical work (Wichmann, 1970),
  90. C           loops 1, 5, and 10 are omitted from the program.
  91. C
  92.             isave = inner
  93.             n2    = 12  * inner
  94.             n3    = 14  * inner
  95.             n4    = 345 * inner
  96.             n6    = 210 * inner
  97.             n7    = 32  * inner
  98.             n8    = 899 * inner
  99.             n9    = 616 * inner
  100.             n11   = 93  * inner
  101.  
  102. C
  103. C           The values in array e1 are arbitrary.
  104. C
  105.             e1(1) =  1.0D00
  106.             e1(2) = -1.0D00
  107.             e1(3) = -1.0D00
  108.             e1(4) = -1.0D00
  109.  
  110. C
  111. C           Loop 1 - Convergence test using real numbers.  The
  112. C           execution of this loop was found to be statistically
  113. C           invalid, but is included here for completeness.
  114. C
  115. C           DO i = 1, n1
  116. C              x1 = ( x1 + x2 + x3 - x4) * t1
  117. C              x2 = ( x1 + x2 - x3 + x4) * t1
  118. C              x3 = ( x1 - x2 + x3 + x4) * t1
  119. C              x4 = (-x1 + x2 + x3 + x4) * t1
  120. C           END DO
  121.  
  122. C
  123. C           Loop 2 - Convergence test using array elements.
  124. C
  125.             DO i = 1, n2
  126.                e1(1) = ( e1(1) + e1(2) + e1(3) - e1(4)) * t1
  127.                e1(2) = ( e1(1) + e1(2) - e1(3) + e1(4)) * t1
  128.                e1(3) = ( e1(1) - e1(2) + e1(3) + e1(4)) * t1
  129.                e1(4) = (-e1(1) + e1(2) + e1(3) + e1(4)) * t1
  130.             END DO
  131.  
  132. C
  133. C           Loop 3 - Convergence test using subroutine calls.
  134. C
  135.             DO i = 1, n3
  136.                CALL sub1( e1 )
  137.             END DO
  138.  
  139. C
  140. C           Loop 4 - Conditional jumps.  Repeated iterations
  141. C           alternate the value of j between 0 and 1.
  142. C
  143.             j = 1
  144.             DO i = 1, n4
  145.                IF( j - 1 ) 20, 10, 20
  146.    10          j = 2
  147.                GOTO 30
  148.    20          j = 3
  149.    30          IF( j - 2 ) 50, 50, 40
  150.    40          j = 0
  151.                GOTO 60
  152.    50          j = 1
  153.    60          IF( j - 1 ) 70, 80, 80
  154.    70          j = 1
  155.                GOTO 100
  156.    80          j = 0
  157.   100       END DO
  158.  
  159. C
  160. C           Loop 6 - Integer arithmetic and array addressing.
  161. C           The values of integers j, k, and l remain unchanged
  162. C           through iterations of loop.
  163. C
  164.             j = 1
  165.             k = 2
  166.             l = 3
  167.             DO i = 1, n6
  168.                j = j * (k - j) * (l - k)
  169.                k = l * k - (l - j) * k
  170.                l = (l - k) * (k + j)
  171.                e1(l - 1) = j + k + l
  172.                e1(k - 1) = j * k * l
  173.             END DO
  174.  
  175. C
  176. C           Loop 7 - Trigonometric functions.  The following loop
  177. C           almost transforms x and y into themselves and produces
  178. C           results that slowly vary.  (The value of t1 ensures
  179. C           slow convergence, as described above.)
  180. C
  181.             x = 0.5D00
  182.             y = 0.5D00
  183.             DO i = 1, n7
  184.                x = t1 * DATAN( t3 * DSIN( x ) * DCOS( x ) /
  185.      +             (DCOS( x + y ) + DCOS( x - y ) - 1.0D00) )
  186.                y = t1 * DATAN( t3 * DSIN( y ) * DCOS( y ) /
  187.      +             (DCOS( x + y ) + DCOS( x - y ) - 1.0D00) )
  188.             END DO
  189.  
  190. C
  191. C           Loop 8 - Subroutine calls.  Values of x, y, and z
  192. C           are arbitrary.
  193. C
  194.             x = 1.0D00
  195.             y = 1.0D00
  196.             z = 1.0D00
  197.             DO i = 1, n8
  198.                CALL sub2( x, y, z )
  199.             END DO
  200.  
  201. C
  202. C           Loop 9 - Array references and subroutine calls.
  203. C
  204.             j = 1
  205.             k = 2
  206.             l = 3
  207.             e1(1) = 1.0D00
  208.             e1(2) = 2.0D00
  209.             e1(3) = 3.0D00
  210.             DO i = 1, n9
  211.                CALL sub3
  212.             END DO
  213.  
  214. C
  215. C           Loop 10 - Simple integer arithmetic.  The execution
  216. C           of this loop was found to be statistically invalid,
  217. C           but is included here for completeness.
  218. C
  219. C           j = 2
  220. C           k = 3
  221. C           DO i = 1, n10
  222. C              j = j + k
  223. C              k = j + k
  224. C              j = j - k
  225. C              k = k - j - j
  226. C           END DO
  227.  
  228. C
  229. C           Loop 11 - Standard functions DSQRT, DEXP, and DLOG.
  230. C
  231.             x = 0.75D00
  232.             DO i = 1, n11
  233.                x = DSQRT( DEXP( DLOG( x ) / t2 ) )
  234.             END DO
  235.  
  236. C
  237. C           End of Whetstone code.
  238. C
  239.  
  240.             inner = isave
  241.             kount = kount + 1
  242.          END DO
  243.  
  244. C
  245. C        End of timed interval
  246. C
  247.  
  248.  
  249.          end_time = secnds()
  250.          dif_time = end_time - begin_time
  251.  
  252. C
  253. C        1000 whetstones (kilowhetstones) = 100 * loops per second
  254. C
  255.  
  256.          kilowhet = 100.0D+00 * DBLE( outer * inner ) / dif_time
  257.  
  258.          WRITE (*,9300) dif_time, kilowhet
  259.  
  260. C
  261. C        Repeat with inner count doubled.
  262. C
  263.          npass = npass + 1
  264.          IF( npass .LT. max_pass ) THEN
  265.             dif_save  = dif_time
  266.             whet_save = kilowhet
  267.             inner     = inner * max_pass
  268.          ENDIF
  269.       END DO
  270.  
  271. C
  272. C     Compute sensitivity.
  273. C
  274.       error       =   dif_time - (dif_save * max_pass )
  275.       whet_err    =   whet_save - kilowhet      
  276.       percent_err =   whet_err * 100.0D+00 / kilowhet
  277.       WRITE (*,*)
  278.       WRITE (*,*)
  279.       WRITE (*,*) ('=', j = 1, 60)
  280.       WRITE (*,9400) error, whet_err, percent_err
  281.       IF( dif_time .LT. 10.0D00 )
  282.      +   WRITE (*,*) 'TIME is less than 10 seconds -- ',
  283.      +               'suggest larger inner loop'
  284.  
  285.  
  286.  9000 FORMAT( '0Number of inner loops (suggest more than 3):  ' \ )
  287.  9100 FORMAT( ' Number of outer loops (suggest more than 1):  ' \ )
  288.  9200 FORMAT( //' Pass #', I3.2, ': ', I10, ' outer loop(s),', I10,
  289.      +           ' inner loop(s)' )
  290.  9300 FORMAT( ' Elapsed time =', F12.2, ' seconds' /
  291.      +        ' Whetstones   =', F12.2,
  292.      +        ' double-precision kilowhets/second' )
  293.  9400 FORMAT( ' Time error   =', F12.2, ' seconds' /
  294.      +        ' Whet error   =', F12.2, ' kwhets/sec' /
  295.      +        ' %    error   =', F12.2, ' % whet error' )
  296.  
  297.       END
  298.  
  299.  
  300.  
  301. C     Subroutines for arithmetic, array assignments
  302. C
  303.  
  304.       SUBROUTINE sub1( e )
  305.  
  306.       REAL*8 t1, t2, t3, e(4)
  307.       COMMON t1, t2, t3
  308.  
  309.       DO i = 1, 6
  310.          e(1) = (e(1)  + e(2) + e(3) - e(4)) * t1
  311.          e(2) = (e(1)  + e(2) - e(3) + e(4)) * t1
  312.          e(3) = (e(1)  - e(2) + e(3) + e(4)) * t1
  313.          e(4) = (-e(1) + e(2) + e(3) + e(4)) / t3
  314.       END DO
  315.       RETURN
  316.       END
  317.  
  318.  
  319.  
  320.       SUBROUTINE sub2( x, y, z )
  321.  
  322.       REAL*8 t1, t2, t3, x1, y1, x, y, z
  323.       COMMON t1, t2, t3
  324.  
  325.       x1 = x
  326.       y1 = y
  327.       x1 = (x1 + y1) * t1
  328.       y1 = (x1 + y1) * t1
  329.       z  = (x1 + y1) / t3
  330.       RETURN
  331.       END
  332.  
  333.  
  334.  
  335.       SUBROUTINE sub3
  336.  
  337.       REAL*8 t1, t2, t3, e1(4)
  338.       COMMON t1, t2, t3, e1, j, k, l
  339.  
  340.       e1(j) = e1(k)
  341.       e1(k) = e1(l)
  342.       e1(l) = e1(j)
  343.       RETURN
  344.       END
  345.  
  346.  
  347.  
  348. CC  SECNDS - Calls GETTIM function to find current time.
  349. CC
  350. CC  Return:  Number of seconds since midnight.
  351. CC
  352.  
  353.       REAL*8 FUNCTION  secnds()
  354.  
  355.       INTEGER*2 hour, minute, second, hundredth
  356.  
  357.       CALL GETTIM( hour, minute, second, hundredth )
  358.       secnds = ((DBLE( hour ) * 3600.0) + (DBLE( minute) * 60.0) +
  359.      +           DBLE( second) + (DBLE( hundredth ) / 100.0))
  360.       END
  361.  
  362.