home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / progjrn / pj_6_1.arc / WHETLIN.ARC / SWHETR.FOR < prev    next >
Text File  |  1987-09-20  |  4KB  |  201 lines
  1. *      real function second()
  2.       
  3. *      external msec
  4. *      second = msec()*0.001
  5. *      end
  6. *
  7. *     a TIME function for Ryan/McFarland Fortran and Microsoft Version 4.0
  8.  
  9. *    Author:    M. Steven Baker
  10. *    Date:    September 20, 1986
  11. *
  12.        real function second()
  13.        integer*2 hh,mm,ss,hd
  14.        call gettim(hh,mm,ss,hd)
  15.        second = float(hh)*3600 + float(mm*60+ss) + float(hd)/100
  16.        end
  17.  
  18.  
  19. *$system
  20.  
  21. C WHETSTONE BENCHMARK PROGRAM
  22. C THIS IS SUPPOSED TO USE A MIX OF INSTRUCTIONS
  23. C TYPICAL OF SCIENTIFIC (FLOATING POINT) CALCULATIONS
  24. C TABLE OF TIMES FOR VARIOUS COMPUTERS IN WHETST.ANSWERS
  25. C I=10 CORRESPONDS TO ONE MILLION WHETSTONE INSTRUCTIONS
  26.       real*4 X1,X2,X3,X4,X,Y,Z,T,T1,T2,E1
  27.     real*4 time1,time2,second
  28.       COMMON T,T1,T2,E1(4),J,K,L
  29.     time1=second()
  30.       I=100
  31.       T1=050025000
  32.       T=0.499975000
  33.       T2=2.0000
  34.       ISAVE=I
  35.       N1=0
  36.       N2=12*I
  37.       N3=14*I
  38.       N4=348*I
  39.       N5=0
  40.       N6=210*I
  41.       N7=32*I
  42.       N8=899*I
  43.       N9=516*I
  44.       N10=0
  45.       N11=93*I
  46.       N12=0
  47.       X1=1.0
  48.       X2=-1.0
  49.       X3=-1.0
  50.       X4=-1.
  51.       IF(N1)19,19,11
  52.    11 DO 18 I=1,N1,1
  53.       X1=(X1+X2+X3-X4)*T
  54.       X2=(X1+X2-X3+X4)*T
  55.       X4=(-X1+X2+X3+X4)*T
  56.       X3=(X1-X2+X3+X4)*T
  57.    18 CONTINUE
  58.    19 CONTINUE
  59. c      CALL POUT(N1,N1,N1,X1,X2,X3,X4)
  60.       E1(1)=1.0
  61.       E1(2)=-1.0
  62.       E1(3)=-1.0
  63.       E1(4)=-1.0
  64.       IF(N2)29,29,21
  65.    21 DO 28 I=1,N2,1
  66.       E1(1)=(E1(1)+E1(2)+E1(3)-E1(4))*T
  67.       E1(2)=(E1(1)+E1(2)-E1(3)+E1(4))*T
  68.       E1(3)=(E1(1)-E1(2)+E1(3)+E1(4))*T
  69.       E1(4)=(-E1(1)+E1(2)+E1(3)+E1(4))*T
  70.    28 CONTINUE
  71.    29 CONTINUE
  72. c      CALL POUT(N2,N3,N2,E1(1),E1(2),E1(3),E1(4))
  73.       IF(N3)39,39,31
  74.    31 DO 38 I=1,N3,1
  75.    38 CALL PA(E1)
  76.   39  CONTINUE
  77. c      CALL POUT(N3,N2,N2,E1(1),E1(2),E1(3),E1(4))
  78.       J=1
  79.       IF(N4)49,49,41
  80.    41 DO 48 I=1,N4,1
  81.       IF(J-1)43,42,43
  82.    42 J=2
  83.       GOTO 44
  84.    43 J=3
  85.    44 IF(J-2)45,46,46
  86.    45 J=0
  87.       GOTO 47
  88.    46 J=1
  89.    47 IF(J-1)411,412,412
  90.   411 J=1
  91.       GOTO 48
  92.   412 J=0
  93.    48 CONTINUE
  94.    49 CONTINUE
  95. c      CALL POUT(N4,J,J,X1,X2,X3,X4)
  96.       J=1
  97.       K=2
  98.       L=3
  99.       IF(N6)69,69,61
  100.    61 DO 68 I=1,N6,1
  101.       J=J*(K-J)*(L-K)
  102.       K=L*K-(L-J)*K
  103.       L=(L-K)*(K+J)
  104.       E1(L-1)=J+K+L
  105.       E1(K-1)=J*K*L
  106.    68 CONTINUE
  107.    69 CONTINUE
  108. c      CALL POUT(N6,J,K,E1(1),E1(2),E1(3),E1(4))
  109.       X=0.5
  110.       Y=0.5
  111.       IF(N7)79,79,71
  112.    71 DO 78 I=1,N7,1
  113.       X=T* ATAN(T2* SIN(X)* COS(X)/( COS(X+Y)+ COS(X-Y)-1.0  ))
  114.       Y=T* ATAN(T2* SIN(Y)* COS(Y)/( COS(X+Y)+ COS(X-Y)-1.0  ))
  115.    78 CONTINUE
  116.    79 CONTINUE
  117. c      CALL POUT(N7,J,K,X,X,Y,Y)
  118.       X=1.0
  119.       Y=1.0
  120.       Z=1.0
  121.       IF(N8)89,89,81
  122.    81 DO 88 I=1,N8,1
  123.    88 CALL P3(X,Y,Z)
  124.    89 CONTINUE
  125. c      CALL POUT(N8,J,K,X,Y,Z,Z)
  126.       J=1
  127.       K=2
  128.       L=3
  129.       E1(1)=1.0
  130.       E1(2)=2.0
  131.       E1(3)=3.0
  132.       IF(N9)99,99,91
  133.    91 DO 98 I=1,N9,1
  134.    98 CALL P0
  135.    99 CONTINUE
  136. c      CALL POUT(N9,J,K,E1(1),E1(2),E1(3),E1(4))
  137.       J=2
  138.       K=3
  139.       IF(N10)109,109,101
  140.   101 DO 108 I=1,N10,1
  141.       J=J+K
  142.       K=J+K
  143.       J=J-K
  144.       K=K-J-J
  145.   108 CONTINUE
  146.   109 CONTINUE
  147. c      CALL POUT(N10,J,K,X1,X2,X3,X4)
  148.       X=0.75
  149.       IF(N11)119,119,111
  150.   111 DO 118 I=1,N11,1
  151.   118 X= SQRT( EXP(LOG(X)/T1))
  152. 119   CONTINUE
  153. c      CALL POUT(N11,J,K,X,X,X,X)
  154.     time2=second()
  155.     time2=time2-time1
  156.       write(*,*) ' elasped time: ',time2
  157.     write(*,*)' execution rate=',100*isave/time2,'K whetstones/sec'
  158.       STOP
  159.       END
  160. C SUBROUTINE PA
  161.       SUBROUTINE PA(E)
  162.       real*4 T,T1,T2,E
  163.       COMMON T,T1,T2
  164.       DIMENSION E(4)
  165.       J=0
  166. 1     E(1)=(E(1)+E(2)+E(3)-E(4))*T
  167.       E(2)=(E(1)+E(2)-E(3)+E(4))*T
  168.       E(3)=(E(1)-E(2)+E(3)+E(4))*T
  169.       E(4)=(-E(1)+E(2)+E(3)+E(4))/T2
  170.       J=J+1
  171.       IF(J-6)1,2,2
  172. 2     CONTINUE
  173.       RETURN
  174.       END
  175. C SUBROUTINE P0
  176.       SUBROUTINE P0
  177.       real*4 T,T1,T2,E1
  178.       COMMON T,T1,T2,E1(4),J,K,L
  179.       E1(J)=E1(K)
  180.       E1(K)=E1(L)
  181.       E1(L)=E1(J)
  182.       RETURN
  183.       END
  184. C SUBROUTINE P3
  185.       SUBROUTINE P3(X,Y,Z)
  186.       real*4 T,T1,T2,X1,Y1,X,Y,Z
  187.       COMMON T,T1,T2
  188.       X=T*(X+Y)
  189.       Y=T*(X+Y)
  190.       Z=(X+Y)/T2
  191.       RETURN
  192.       END
  193. C SUBROUTINE POUT
  194.       SUBROUTINE POUT(N,J,K,X1,X2,X3,X4)
  195.       real*4 X1,X2,X3,X4
  196.       WRITE(6,1)N,J,K,X1,X2,X3,X4
  197. 1     FORMAT(1H ,3I7,4E12.4)
  198.       RETURN
  199.       END
  200.   
  201.