1 REM  ********************************
2 REM  *                              *
3 REM  *    FAST FOURIER TRANSFORM    *
4 REM  *         Versio 1.01          *
5 REM  *                              *
6 REM  *  Ohjelma suorittaa nopean    *
7 REM  *  Fourier-muunnoksen annetul- *
8 REM  *  le datalle                  *
9 REM  *                              *
10 REM *     Dr. Gy|rgy Tott 1984     *
11 REM *                              *
12 REM *    MBasic/GWBasic sovitus    *
13 REM *       Veikko M{kel{          *
14 REM *         12.2.1987            *
15 REM *                              *
16 REM ********************************
17 :
18 REM *********** TAULUKOT ***********
19 :
20 DIM V(128),W(128)
21 :
22 REM ********* N[YT\N OHJAUS ********
23 REM   Spectravideo 318/328 (VT-52)
24 :
25 CLR$=CHR$(12)        :REM Clr screen
26 HM$=CHR$(11)         :REM Csr home
27 BL$=CHR$(7)          :REM Bell
28 :
29 REM ************ VAKIOT ************
30 :
31 PI=3.14159265#
32 :
33 REM ********************************
34 :
35 GOTO 157        :REM ->P[[OHJELMA
36 :
37 REM ******* HAVAINTOJEN LKM ********
38 :
39 PRINT CLR$;
40 PRINT "******** NOPEA FOURIER-MUUNNOS *********"
41 PRINT
42 PRINT "Havaintojen lkm (2,4,8,16,32,64,128)";
43 INPUT N
44 IF N<2 THEN 47
45 IF LOG(N)/LOG(2)=INT(LOG(N)/LOG(2)) THEN 51
46 :
47 PRINT BL$;BL$;"Havaintojen lkm virheellinen!"
48 PRINT HM$;
49 GOTO 40
50 :
51 RETURN
52 :
53 REM ****** HAVAINTOJEN SY\TT\ ******
54 :
55 PRINT CLR$;
56 PRINT "**** HAVAINTOJEN SY\TT\ ****"
57 PRINT
58 PRINT "Anna havainnot:"
59 PRINT
60 FOR I=1 TO N
61   PRINT I;
62   INPUT V(I)
63 NEXT
64 :
65 RETURN
66 :
67 REM ******** MUUNNOSMUOTO **********
68 :
69 PRINT CLR$;
70 PRINT "Suoritetaanko"
71 PRINT
72 PRINT "1  suora"
73 PRINT "2  k{{nteinen"
74 PRINT
75 PRINT "Fourier muunnos? ->";
76 A$=INKEY$  :IF A$="" THEN 76
77 FF=VAL(A$)
78 IF FF=1 OR FF=2 THEN 85
79 :
80 PRINT
81 PRINT BL$;BL$;"V{{r{ valinta!"
82 PRINT HM$;
83 GOTO 70
84 :
85 RETURN
86 :
87 REM ******* FOURIER-MUUNNOS ********
88 :
89 MR=0
90 NN=N-1
91 FOR M=1 TO NN
92   L=N
93   L=L/2
94   IF (MR+L)>NN THEN 93
95   MR=MR-L*INT(MR/L)+L
96   IF MR<=M THEN 103
97     TR=V(M+1)
98     V(M+1)=V(MR+1)
99     V(MR+1)=TR
100     TI=W(M+1)
101     W(M+1)=W(MR+1)
102     W(MR+1)=TI
103 NEXT
104 :
105 L=1
106 IF L>=N THEN 127
107   ISTEP=2*L
108   EL=L
109   FOR M=1 TO L
110     A=PI*(1-M)/EL
111     C=COS(A)
112     S=SIN(A)
113     IF FF=2 THEN S=-S
114     FOR I=M TO N STEP ISTEP
115       J=I+L
116       TR=C*V(J)-S*W(J)
117       TI=C*W(J)+S*V(J)
118       V(J)=V(I)-TR
119       W(J)=W(I)-TI
120       V(I)=V(I)+TR
121       W(I)=W(I)+TI
122     NEXT
123   NEXT    
124   L=ISTEP
125   GOTO 106
126 :
127 IF FF=2 THEN 133
128   FOR I=1 TO N
129     V(I)=V(I)/N
130     W(I)=W(I)/N
131   NEXT
132 :
133 RETURN
134 :
135 REM *********** TULOSTUS **********
136 :
137 PRINT CLR$
138 PRINT "******** NOPEA FOURIER-MUUNNOS *********"
139 PRINT
140 PRINT " N      REAL         IMAG      ABS.ARVO"
141 PRINT
142 FOR I=1 TO N
143  PRINT I;TAB(5);
144  PRINT USING "#####.###"; V(I);
145  PRINT TAB(18);
146  PRINT USING "#####.###"; W(I);
147  PRINT TAB(30);
148  PRINT USING "#####.###"; SQR(V(I)*V(I)+W(I)*W(I))
149 NEXT
150 :
151 PRINT
152 PRINT "Paina <RETURN>"
153 INPUT C$
154 :
155 RETURN
156 :
157 REM ********** P[[OHJELMA *********
158 :
159 FOR I=1 TO 128
160   V(I)=0 :W(I)=0
161 NEXT
162 :
163 GOSUB 37    :REM ->HAVAINTOJEN LKM
164 GOSUB 53    :REM ->HAVAINTOJEN SY\TT\
165 GOSUB 67    :REM ->MUUNNOSMUOTO
166 GOSUB 87    :REM ->FOURIER-MUUNNOS
167 GOSUB 135   :REM ->TULOSTUS
168 :
169 PRINT CLR$;
170 PRINT "Uusi muunnos? K/E: ";
171 U$=INKEY$  :IF U$="" THEN 171
172 IF U$="K" OR U$="k" THEN 165
173 :
174 PRINT
175 PRINT "Uusi data? K/E: ";
176 U$=INKEY$  :IF U$="" THEN 176
177 IF U$="K" OR U$="k" THEN 159
178 :
179 END
180 :
181 REM ******* End of program ********