home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Languages Suite
/
ProgLangD.iso
/
Fortran.51
/
DISK6
/
DWHET.FO$
/
DWHET.bin
Wrap
Text File
|
1991-03-13
|
10KB
|
362 lines
CC DWHET.FOR - Double precision Whetstone program.
CC Measures FORTRAN and CPU performance in
CC Whetstone-instructions per second.
CC
CC
CC References on Whetstones:
CC
CC - Computer Journal Feb 76
CC pg 43-49 vol 19 no 1.
CC Curnow and Wichmann.
CC
CC - Timing Studies Using a
CC Synthetic Whetstone Benchmark,
CC S. Harbaugh & J. Forakris
CC
CC References on FORTRAN Benchmarks:
CC
CC - Computer Languages, Jan 1986
CC - EDN, Oct 3, 1985, Array Processors
CC for PCs
CC - Byte, Feb 1984.
CC
INTEGER*4 j, k, l, i, isave
INTEGER*4 n2, n3, n4, n6, n7, n8, n9, n11
INTEGER*4 inner, outer, kount, npass, max_pass
REAL*8 x, y, z, t1, t2, t3, e1(4)
REAL*8 whet_save, dif_save, kilowhet
REAL*8 begin_time, end_time, dif_time
REAL*8 error, whet_err, percent_err
REAL*8 secnds
COMMON t1, t2, t3, e1, j, k, l
C
C Initialize pass-control variables. DWHET must make at least
C two passes to calculate sensitivity terms. NPASS counts passes;
C MAX_PASS is the maximum number of passes. Currently the program
C is written such that MAX_PASS should have a value of 2. For higher
C values of MAX_PASS, modifications to the program are required.
C
npass = 0
max_pass = 2
WRITE (*,9000)
READ (*,*) inner
WRITE (*,9100)
READ (*,*) outer
DO WHILE( npass .LT. max_pass)
WRITE (*,9200) npass + 1, outer, inner
WRITE (*,*) ('=', j = 1, 60)
kount = 0
begin_time = secnds()
C
C Beginning of timed interval
C
DO WHILE( kount .LT. outer )
C
C Whetstone code begins here. First initialize variables
C and loop counters based on the number of inner loops.
C
C Loops 2 and 3 (described below) use variations of the
C following transformation statements:
C
C x1 = ( x1 + x2 + x3 - x4) * 0.5
C x2 = ( x1 + x2 - x3 + x4) * 0.5
C x3 = ( x1 - x2 + x3 + x4) * 0.5
C x4 = (-x1 + x2 + x3 + x4) * 0.5
C
C Theoretically this set tends to the solution
C
C x1 = x2 = x3 = x4 = 1.0
C
C The variables t1, t2, and t3 are terms designed to limit
C convergence of the set.
C
t1 = 0.499975D00
t2 = 0.50025D00
t3 = 2.0D00
C
C The variables n2-n11 are counters for Loops 2-11.
C Based on earlier statistical work (Wichmann, 1970),
C loops 1, 5, and 10 are omitted from the program.
C
isave = inner
n2 = 12 * inner
n3 = 14 * inner
n4 = 345 * inner
n6 = 210 * inner
n7 = 32 * inner
n8 = 899 * inner
n9 = 616 * inner
n11 = 93 * inner
C
C The values in array e1 are arbitrary.
C
e1(1) = 1.0D00
e1(2) = -1.0D00
e1(3) = -1.0D00
e1(4) = -1.0D00
C
C Loop 1 - Convergence test using real numbers. The
C execution of this loop was found to be statistically
C invalid, but is included here for completeness.
C
C DO i = 1, n1
C x1 = ( x1 + x2 + x3 - x4) * t1
C x2 = ( x1 + x2 - x3 + x4) * t1
C x3 = ( x1 - x2 + x3 + x4) * t1
C x4 = (-x1 + x2 + x3 + x4) * t1
C END DO
C
C Loop 2 - Convergence test using array elements.
C
DO i = 1, n2
e1(1) = ( e1(1) + e1(2) + e1(3) - e1(4)) * t1
e1(2) = ( e1(1) + e1(2) - e1(3) + e1(4)) * t1
e1(3) = ( e1(1) - e1(2) + e1(3) + e1(4)) * t1
e1(4) = (-e1(1) + e1(2) + e1(3) + e1(4)) * t1
END DO
C
C Loop 3 - Convergence test using subroutine calls.
C
DO i = 1, n3
CALL sub1( e1 )
END DO
C
C Loop 4 - Conditional jumps. Repeated iterations
C alternate the value of j between 0 and 1.
C
j = 1
DO i = 1, n4
IF( j - 1 ) 20, 10, 20
10 j = 2
GOTO 30
20 j = 3
30 IF( j - 2 ) 50, 50, 40
40 j = 0
GOTO 60
50 j = 1
60 IF( j - 1 ) 70, 80, 80
70 j = 1
GOTO 100
80 j = 0
100 END DO
C
C Loop 6 - Integer arithmetic and array addressing.
C The values of integers j, k, and l remain unchanged
C through iterations of loop.
C
j = 1
k = 2
l = 3
DO 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
END DO
C
C Loop 7 - Trigonometric functions. The following loop
C almost transforms x and y into themselves and produces
C results that slowly vary. (The value of t1 ensures
C slow convergence, as described above.)
C
x = 0.5D00
y = 0.5D00
DO i = 1, n7
x = t1 * DATAN( t3 * DSIN( x ) * DCOS( x ) /
+ (DCOS( x + y ) + DCOS( x - y ) - 1.0D00) )
y = t1 * DATAN( t3 * DSIN( y ) * DCOS( y ) /
+ (DCOS( x + y ) + DCOS( x - y ) - 1.0D00) )
END DO
C
C Loop 8 - Subroutine calls. Values of x, y, and z
C are arbitrary.
C
x = 1.0D00
y = 1.0D00
z = 1.0D00
DO i = 1, n8
CALL sub2( x, y, z )
END DO
C
C Loop 9 - Array references and subroutine calls.
C
j = 1
k = 2
l = 3
e1(1) = 1.0D00
e1(2) = 2.0D00
e1(3) = 3.0D00
DO i = 1, n9
CALL sub3
END DO
C
C Loop 10 - Simple integer arithmetic. The execution
C of this loop was found to be statistically invalid,
C but is included here for completeness.
C
C j = 2
C k = 3
C DO i = 1, n10
C j = j + k
C k = j + k
C j = j - k
C k = k - j - j
C END DO
C
C Loop 11 - Standard functions DSQRT, DEXP, and DLOG.
C
x = 0.75D00
DO i = 1, n11
x = DSQRT( DEXP( DLOG( x ) / t2 ) )
END DO
C
C End of Whetstone code.
C
inner = isave
kount = kount + 1
END DO
C
C End of timed interval
C
end_time = secnds()
dif_time = end_time - begin_time
C
C 1000 whetstones (kilowhetstones) = 100 * loops per second
C
kilowhet = 100.0D+00 * DBLE( outer * inner ) / dif_time
WRITE (*,9300) dif_time, kilowhet
C
C Repeat with inner count doubled.
C
npass = npass + 1
IF( npass .LT. max_pass ) THEN
dif_save = dif_time
whet_save = kilowhet
inner = inner * max_pass
ENDIF
END DO
C
C Compute sensitivity.
C
error = dif_time - (dif_save * max_pass )
whet_err = whet_save - kilowhet
percent_err = whet_err * 100.0D+00 / kilowhet
WRITE (*,*)
WRITE (*,*)
WRITE (*,*) ('=', j = 1, 60)
WRITE (*,9400) error, whet_err, percent_err
IF( dif_time .LT. 10.0D00 )
+ WRITE (*,*) 'TIME is less than 10 seconds -- ',
+ 'suggest larger inner loop'
9000 FORMAT( '0Number of inner loops (suggest more than 3): ' \ )
9100 FORMAT( ' Number of outer loops (suggest more than 1): ' \ )
9200 FORMAT( //' Pass #', I3.2, ': ', I10, ' outer loop(s),', I10,
+ ' inner loop(s)' )
9300 FORMAT( ' Elapsed time =', F12.2, ' seconds' /
+ ' Whetstones =', F12.2,
+ ' double-precision kilowhets/second' )
9400 FORMAT( ' Time error =', F12.2, ' seconds' /
+ ' Whet error =', F12.2, ' kwhets/sec' /
+ ' % error =', F12.2, ' % whet error' )
END
C Subroutines for arithmetic, array assignments
C
SUBROUTINE sub1( e )
REAL*8 t1, t2, t3, e(4)
COMMON t1, t2, t3
DO i = 1, 6
e(1) = (e(1) + e(2) + e(3) - e(4)) * t1
e(2) = (e(1) + e(2) - e(3) + e(4)) * t1
e(3) = (e(1) - e(2) + e(3) + e(4)) * t1
e(4) = (-e(1) + e(2) + e(3) + e(4)) / t3
END DO
RETURN
END
SUBROUTINE sub2( x, y, z )
REAL*8 t1, t2, t3, x1, y1, x, y, z
COMMON t1, t2, t3
x1 = x
y1 = y
x1 = (x1 + y1) * t1
y1 = (x1 + y1) * t1
z = (x1 + y1) / t3
RETURN
END
SUBROUTINE sub3
REAL*8 t1, t2, t3, e1(4)
COMMON t1, t2, t3, e1, j, k, l
e1(j) = e1(k)
e1(k) = e1(l)
e1(l) = e1(j)
RETURN
END
CC SECNDS - Calls GETTIM function to find current time.
CC
CC Return: Number of seconds since midnight.
CC
REAL*8 FUNCTION secnds()
INTEGER*2 hour, minute, second, hundredth
CALL GETTIM( hour, minute, second, hundredth )
secnds = ((DBLE( hour ) * 3600.0) + (DBLE( minute) * 60.0) +
+ DBLE( second) + (DBLE( hundredth ) / 100.0))
END