home *** CD-ROM | disk | FTP | other *** search
/ Microsoft Programmer's Library 1.3 / Microsoft-Programers-Library-v1.3.iso / sampcode / fortran / whetston.for < prev   
Text File  |  1988-11-18  |  7KB  |  266 lines
  1.  
  2.     SUBROUTINE second (t1)
  3. C
  4. C  MS version of SECOND (timing routine)
  5. C
  6.     INTEGER*2 ih,im,is,ihu
  7.     INTEGER*4 t1
  8.     CALL gettim(ih,im,is,ihu)
  9.     t1 = (ih*3600+im*60+is)*100+ihu
  10.     END
  11. C       WHETS.FOR       09/27/77     TDR
  12. C       ...WHICH IS AN IMPROVED VERSION OF:
  13. C       WHET2A.FTN      01/22/75     RBG
  14. C       DOUBLE-PRECISION VARIANT OF PROGRAM
  15. C
  16. C       "WHETSTONE INSTRUCTIONS PER SECONDS" MEASURE OF FORTRAN
  17. C       AND CPU PERFORMANCE.
  18. C
  19. C       9/24/84
  20. C
  21. C          ADDED CODE TO THESE SO THAT IT HAS VARIABLE LOOPING
  22. C
  23. C          from DEC but DONE BY OUTSIDE CONTRACTOR, OLD STYLE CODING
  24. C          not representative of DEC THIS PROGRAM IS THE
  25. C
  26. C          A. TETEWSKY, 555 TECH SQ MS 92
  27. C          CAMBRIDGE MASS 02139           617/258-1487
  28. C
  29. C        ========= MICROSOFT OPT CODES ===========
  30. C
  31. C        COMPILE          LINK             COMMENT
  32. C
  33. C        FLOAT            MATH             GOOD FOR ON THE FLY
  34. C                         8087             ONLY WITH 8087
  35. C                         ALTLIB           BEST W/O 8087
  36. C                                          IF NO 8087, FLOAT FASTER
  37. C                                             THEN NOFLOAT
  38. C
  39. C        NOFLOAT          MATH             BEST ON THE FLY 8087
  40. C                         8087             ONLY WITH 8087
  41. C                         ALTLIB           CAN'T DO
  42. C
  43. C                                          IF 8087, NOFLOAT
  44. C                                             IS BEST
  45. C
  46. C
  47.         DOUBLE PRECISION X1,X2,X3,X4,X,Y,Z,T,T1,T2,E1
  48. C
  49.         DIMENSION TIMES(3)
  50. C
  51. C       ...       END = SECNDS(X) YIELDS TIME IN SECONDS
  52. C                 END = TIME - MIDNITE - X
  53. C                 INTERFRACE YOUR ROUTINE TO SECNDS
  54. C
  55. C
  56. C
  57. C
  58. C       COMMON WHICH REFERENCES LOGICAL UNIT ASSIGNMENTS
  59. C
  60.         INTEGER  IMUCH
  61.     INTEGER*4 temp
  62. C
  63.         COMMON T,T1,T2,E1(4),J,K,L
  64.         COMMON /LUNS/ ICRD,ILPT,IKBD,ITTY
  65. C
  66.         ITTY   =    0
  67.         IKBD   =    0
  68.         T      =    0.499975D00
  69.         T1     =    0.50025D00
  70.         T2     =    2.0D00
  71.  
  72. C
  73.         IMUCH = 10
  74. C
  75. C       ***** BEGININNING OF TIMED INTERVAL *****
  76.         DO 200 ILOOP = 1,3
  77.           I = ILOOP * IMUCH
  78. C         times(ILOOP) = SECNDS(0.)
  79.           CALL second(temp)
  80.           times(iloop) = temp/100.
  81. C       *******************************************
  82. C
  83. C       *****                               *****
  84. C
  85.         ISAVE=I
  86.         N1=0
  87.         N2=12*I
  88.         N3=14*I
  89.         N4=345*I
  90.         N5=0
  91.         N6=210*I
  92.         N7=32*I
  93.         N8=899*I
  94.         N9=616*I
  95.         N10=0
  96.         N11=93*I
  97.         N12=0
  98.         X1=1.0D0
  99.         X2=-1.0D0
  100.         X3=-1.0D0
  101.         X4=-1.0D0
  102.         IF (N1) 19,19,11
  103.  11     DO 18 I=1,N1,1
  104.           X1=(X1+X2+X3-X4)*T
  105.           X2=(X1+X2-X3+X4)*T
  106.           X4=(-X1+X2+X3+X4)*T
  107.           X3=(X1-X2+X3+X4)*T
  108.  18     CONTINUE
  109.  19     CONTINUE
  110.         CALL POUT(N1,N1,N1,X1,X2,X3,X4)
  111.         E1(1)=1.0D0
  112.         E1(2)=-1.0D0
  113.         E1(3)=-1.0D0
  114.         E1(4)=-1.0D0
  115.         IF (N2) 29,29,21
  116.  21     DO 28 I=1,N2,1
  117.           E1(1)=(E1(1)+E1(2)+E1(3)-E1(4))*T
  118.           E1(2)=(E1(1)+E1(2)-E1(3)+E1(4))*T
  119.           E1(3)=(E1(1)-E1(2)+E1(3)+E1(4))*T
  120.           E1(4)=(-E1(1)+E1(2)+E1(3)+E1(4))*T
  121.  28     CONTINUE
  122.  29     CONTINUE
  123.         CALL POUT(N2,N3,N2,E1(1),E1(2),E1(3),E1(4))
  124.         IF (N3) 39,39,31
  125.  31     DO 39 I=1,N3,1
  126.  38       CALL PA(E1)
  127.  39     CONTINUE
  128.         CALL POUT(N3,N2,N2,E1(1),E1(2),E1(3),E1(4))
  129.         J=1
  130.         IF (N4) 49,49,41
  131.  41     DO 48 I=1,N4,1
  132.           IF (J-1) 43,42,43
  133.  42       J=2
  134.           GOTO 44
  135.  43       J=3
  136.  44       IF (J-2) 46,46,45
  137.  45       J=0
  138.           GOTO 47
  139.  46       J=1
  140.  47       IF (J-1) 411,412,412
  141.  411      J=1
  142.           GOTO 48
  143.  412      J=0
  144.  48     CONTINUE
  145.  49     CONTINUE
  146.         CALL POUT(N4,J,J,X1,X2,X3,X4)
  147.         J=1
  148.         K=2
  149.         L=3
  150.         IF (N6) 69,69,61
  151.  61     DO 68 I=1,N6,1
  152.           J=J*(K-J)*(L-K)
  153.           K=L*K-(L-J)*K
  154.           L=(L-K)*(K+J)
  155.           E1(L-1)=J+K+L
  156.           E1(K-1)=J*K*L
  157.  68     CONTINUE
  158.  69     CONTINUE
  159.         CALL POUT(N6,J,K,E1(1),E1(2),E1(3),E1(4))
  160.         X=0.5D0
  161.         Y=0.5D0
  162.         IF (N7) 79,79,71
  163.  71     DO 78 I=1,N7,1
  164.           X=T*DATAN(T2*DSIN(X)*DCOS(X)/(DCOS(X+Y)+DCOS(X-Y)-1.0D0))
  165.           Y=T*DATAN(T2*DSIN(Y)*DCOS(Y)/(DCOS(X+Y)+DCOS(X-Y)-1.0D0))
  166.  78     CONTINUE
  167.  79     CONTINUE
  168.         CALL POUT(N7,J,K,X,X,Y,Y)
  169.         X=1.0D0
  170.         Y=1.0D0
  171.         Z=1.0D0
  172.         IF (N8) 89,89,81
  173.  81     DO 89 I=1,N8,1
  174.  88       CALL P3(X,Y,Z)
  175.  89     CONTINUE
  176.         CALL POUT(N8,J,K,X,Y,Z,Z)
  177.         J=1
  178.         K=2
  179.         L=3
  180.         E1(1)=1.0D0
  181.         E1(2)=2.0D0
  182.         E1(3)=3.0D0
  183.         IF (N9) 99,99,91
  184.  91     DO 99 I=1,N9,1
  185.  98       CALL P0
  186.  99     CONTINUE
  187.         CALL POUT(N9,J,K,E1(1),E1(2),E1(3),E1(4))
  188.         J=2
  189.         K=3
  190.         IF (N10) 109,109,101
  191.  101    DO 108 I=1,N10,1
  192.           J=J+K
  193.           K=J+K
  194.           J=J-K
  195.           K=K-J-J
  196.  108    CONTINUE
  197.  109    CONTINUE
  198.         CALL POUT(N10,J,K,X1,X2,X3,X4)
  199.         X=0.75D0
  200.         IF (N11) 119,119,111
  201.  111    DO 119 I=1,N11,1
  202.  118      X=DSQRT(DEXP(DLOG(X)/T1))
  203.  119    CONTINUE
  204.         CALL POUT(N11,J,K,X,X,X,X)
  205. C
  206. C       ***** END OF TIMED INTERVAL         *****
  207.         CALL SECOND(TEMP)
  208. 200     TIMES(ILOOP)=TEMP/100.-TIMES(ILOOP)
  209. C
  210. C       WHET. IPS = 1000/(TIME FOR 10 ITERATIONS OF PROGRAM LOOP)
  211.         WHETS = (10000.0 * FLOAT(IMUCH)/100.0)/(TIMES(3)-TIMES(2))
  212.         WRITE (*,201) WHETS
  213. 201     FORMAT(' SPEED IS: ',1PE10.3,' THOUSAND WHETSTONE',
  214.      2     ' DOUBLE PRECISION INSTRUCTIONS PER SECOND')
  215.     WRITE (*,*) 'Elapsed=',INT((TIMES(3)-TIMES(1))*100),' whetd3h '
  216. C
  217. C
  218.         STOP
  219.         END
  220.         SUBROUTINE PA(E)
  221.         DOUBLE PRECISION T,T1,T2,E
  222.         COMMON T,T1,T2
  223.         DIMENSION E(4)
  224.         J=0
  225.  1      E(1)=(E(1)+E(2)+E(3)-E(4))*T
  226.         E(2)=(E(1)+E(2)-E(3)+E(4))*T
  227.         E(3)=(E(1)-E(2)+E(3)+E(4))*T
  228.         E(4)=(-E(1)+E(2)+E(3)+E(4))/T2
  229.         J=J+1
  230.         IF (J-6) 1,2,2
  231.  2      CONTINUE
  232.         RETURN
  233.         END
  234.  
  235.  
  236.         SUBROUTINE P0
  237.         DOUBLE PRECISION T,T1,T2,E1
  238.         COMMON T,T1,T2,E1(4),J,K,L
  239.         E1(J)=E1(K)
  240.         E1(K)=E1(L)
  241.         E1(L)=E1(J)
  242.         RETURN
  243.         END
  244.  
  245.  
  246.         SUBROUTINE P3(X,Y,Z)
  247.         DOUBLE PRECISION T,T1,T2,X1,Y1,X,Y,Z
  248.         COMMON T,T1,T2
  249.         X1=X
  250.         Y1=Y
  251.         X1=T*(X1+Y1)
  252.         Y1=T*(X1+Y1)
  253.         Z=(X1+Y1)/T2
  254.         RETURN
  255.         END
  256.  
  257.  
  258.         SUBROUTINE POUT(N,J,K,X1,X2,X3,X4)
  259. C
  260. C       WRITE STATEMENT COMMENTED OUT TO IMPROVE REPEATABILITY OF TIMINGS
  261. C
  262.         DOUBLE PRECISION X1,X2,X3,X4
  263.  1      FORMAT('  ',3I7,4E12.4)
  264.         RETURN
  265.         END
  266.