home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #27 / NN_1992_27.iso / spool / alt / lang / basic / 843 < prev    next >
Encoding:
Text File  |  1992-11-16  |  5.2 KB  |  213 lines
  1. Newsgroups: alt.lang.basic
  2. Path: sparky!uunet!caen!destroyer!news.iastate.edu!kwj
  3. From: kwj@iastate.edu (kwj)
  4. Subject: FFT.BAS
  5. Message-ID: <BxtIEw.3t8@news.iastate.edu>
  6. Sender: news@news.iastate.edu (USENET News System)
  7. Organization: Iowa State University, Ames, IA
  8. Date: Mon, 16 Nov 1992 16:42:29 GMT
  9. Lines: 202
  10.  
  11. DECLARE SUB working ()
  12. DECLARE SUB test (x#(), N%)
  13. DECLARE SUB printout (x#(), N%)
  14. DECLARE SUB fftsetup (x#(), N%)
  15. DECLARE SUB XFFT (x#(), NN%)
  16. DEFDBL A-H, O-Z
  17. DEFINT I-N
  18. '$DYNAMIC
  19. DIM x(1 TO 8192)
  20. CONST filenotfound = 53
  21. CONST badfilename = 64
  22. CONST pi = 3.1415926535898#
  23.  
  24. ON ERROR GOTO ErrorHandler
  25. CALL fftsetup(x(), N)
  26.  
  27. LOCATE 10, 1: PRINT "Calculating FFT.";
  28. CALL XFFT(x(), N)
  29.  
  30. CALL printout(x(), N)
  31.  
  32. END
  33.  
  34. ErrorHandler:
  35.    IF ERR = filenotfound THEN
  36.       CLS
  37.       ' get another file name
  38.       LOCATE 5, 5: PRINT "File "; UCASE$(file$); " not found."
  39.       LOCATE 6, 5: INPUT "Enter Data Filename:  ", file$
  40.       RESUME
  41.    ELSEIF ERR = badfilename THEN
  42.       CLS
  43.       ' get another file name
  44.       LOCATE 5, 5: PRINT "File "; UCASE$(file$); " is a bad filename."
  45.       LOCATE 6, 5: INPUT "Enter Data Filename:  ", file$
  46.       RESUME
  47.     ELSE
  48.       PRINT "FFT Choked:  Error Code"; ERR
  49. END
  50. END IF
  51.  
  52.  
  53.  
  54. REM $STATIC
  55. SUB fftsetup (x(), N)
  56.  
  57. CLS
  58. 10 :
  59. LOCATE 5, 10: PRINT "     Power   Number"
  60. LOCATE 6, 10: PRINT "    ------- --------"
  61. LOCATE 7, 10: PRINT "       0       1  "
  62. LOCATE 8, 10: PRINT "       1       2  "
  63. LOCATE 9, 10: PRINT "       2       4 "
  64. LOCATE 10, 10: PRINT "       3       8  "
  65. LOCATE 11, 10: PRINT "       4      16  "
  66. LOCATE 12, 10: PRINT "       5      32  "
  67. LOCATE 13, 10: PRINT "       6      64  "
  68. LOCATE 14, 10: PRINT "       7     128  "
  69. LOCATE 15, 10: PRINT "       8     256  "
  70. LOCATE 16, 10: PRINT "       9     512  "
  71. LOCATE 17, 10: PRINT "      10    1024  "
  72. LOCATE 18, 10: PRINT "      11    2048  "
  73. LOCATE 19, 10: PRINT "      12    4096  "
  74.  
  75. LOCATE 21, 5: INPUT "Enter Power of Record Length:  ", ans$
  76. M = INT(VAL(ans$))
  77. IF M > 12 THEN
  78.         CLS
  79.         LOCATE 22, 5: PRINT "*** Power Must be Lower than 13 ***"
  80.         GOTO 10
  81. ELSEIF M <= 0 THEN
  82.         CLS
  83.         LOCATE 22, 5: PRINT "*** Power Must be Greater than 0 ***"
  84.         GOTO 10
  85. END IF
  86.         LOCATE 22, 5: PRINT "                                      "
  87.  
  88. LOCATE 22, 5: INPUT "Enter Data Filename:  ", file$
  89. OPEN file$ FOR INPUT AS #1
  90. k = 1
  91. N = 2 ^ M
  92. CLS
  93.  
  94. LOCATE 9, 1: PRINT "Reading data."
  95. DO WHILE NOT EOF(1) AND k <= 2 * N - 1
  96.                 working
  97.                 INPUT #1, x(k)
  98.                 x(k + 1) = 0  'imaginary component
  99.                 k = k + 2
  100. LOOP
  101.  
  102. DO UNTIL k > 2 * N - 1
  103.                 x(k) = 0          'Real Data Component
  104.                 x(k + 1) = 0      'Imaginary Data Component
  105.                 k = k + 2
  106. LOOP
  107. CLOSE #1
  108.  
  109. END SUB
  110.  
  111. SUB printout (x(), N)
  112. LOCATE 11, 1: PRINT "Writing to FFT.PRN."
  113. OPEN "c:\fft.prn" FOR OUTPUT AS #1
  114.  
  115. wcount = 0
  116. FOR i = 1 TO 2 * N - 1 STEP 2
  117.         working
  118.         PRINT #1, USING "#####  +.####^^^^^ +.####^^^^^ i"; (i - 1) / 2; CSNG(x(i)); CSNG(x(i + 1))
  119. NEXT i
  120. CLOSE #1
  121. LOCATE 5, 1: PRINT "                                     "
  122. LOCATE 9, 1: PRINT "                                     "
  123. LOCATE 10, 1: PRINT "                                     "
  124. LOCATE 11, 1: PRINT "                                     "
  125.  
  126. LOCATE 12, 1: PRINT "Program Finished."
  127. END SUB
  128.  
  129. DEFSNG A-Z
  130. SUB working STATIC
  131. IF iter = 0 THEN wcount = 15
  132. IF wcount = 15 THEN
  133.         iter = iter + 1
  134.         IF iter = 5 THEN iter = 1
  135.         COLOR 7
  136.         LOCATE 5, 1: PRINT "Working ..."
  137.         COLOR 3
  138.         SELECT CASE iter
  139.  
  140.         CASE 1
  141.                 LOCATE 5, 13: PRINT "-";
  142.         CASE 2
  143.                 LOCATE 5, 13: PRINT "\";
  144.         CASE 3
  145.                 LOCATE 5, 13: PRINT "|";
  146.         CASE 4
  147.                 LOCATE 5, 13: PRINT "/";
  148.         END SELECT
  149.  
  150.         COLOR 7
  151.         wcount = 0
  152. END IF
  153. wcount = wcount + 1
  154.  
  155.  
  156. workingend:
  157. END SUB
  158.  
  159. DEFINT I-N
  160. DEFDBL A-H, O-Z
  161. SUB XFFT (x(), NN)
  162. N = 2 * NN
  163. j = 1
  164. FOR i = 1 TO N STEP 2                           'Bit Reversal
  165.         IF j > i THEN
  166.                 Tempr = x(j)
  167.                 Tempi = x(j + 1)
  168.                 x(j) = x(i)
  169.                 x(j + 1) = x(i + 1)
  170.                 x(i) = Tempr
  171.                 x(i + 1) = Tempi
  172.         END IF
  173.         M = N / 2
  174. 1 :    
  175.         IF M >= 2 AND j > M THEN
  176.                 j = j - M
  177.                 M = M / 2
  178.                 GOTO 1
  179.         END IF
  180.         j = j + M
  181. NEXT i
  182. Mmax = 2
  183. 2 :
  184.         IF N > Mmax THEN
  185.         Istep = 2 * Mmax
  186.         Theta = 2 * pi / (Mmax)
  187.         Wpr = -2! * SIN(.5 * Theta) ^ 2
  188.         Wpi = -SIN(Theta)
  189.         Wr = 1
  190.         Wi = 0
  191.         FOR M = 1 TO Mmax STEP 2
  192.  
  193.                                 working
  194.  
  195.                 FOR i = M TO N STEP Istep
  196.                         j = i + Mmax
  197.                         Tempr = Wr * x(j) - Wi * x(j + 1)
  198.                         Tempi = Wr * x(j + 1) + Wi * x(j)
  199.                         x(j) = x(i) - Tempr
  200.                         x(j + 1) = x(i + 1) - Tempi
  201.                         x(i) = x(i) + Tempr
  202.                         x(i + 1) = x(i + 1) + Tempi
  203.                 NEXT i
  204.                 Wtemp = Wr
  205.                 Wr = Wr * Wpr - Wi * Wpi + Wr
  206.                 Wi = Wi * Wpr + Wtemp * Wpi + Wi
  207.         NEXT M
  208.         Mmax = Istep
  209.         GOTO 2
  210. END IF
  211. END SUB
  212.  
  213.