home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / tech / design2 / sabinfix.asc < prev    next >
Encoding:
Text File  |  1986-10-29  |  17.4 KB  |  432 lines
  1. 10 PRINT:PRINT "WAVEFORM ANALYSIS:"
  2. 20 PRINT "DERIVED FROM W.E. SABIN - EDN JUNE 1983 - PAGE 243"
  3. 22 PRINT "MODIFIED AND EXTENDED BY R.B. KOLBLY - MARCH 11, 1985
  4. 30 INPUT "ENTER EXPONENT M ";M
  5. 40 N=2^M: PI=3.1415928159#:E1=2
  6. 50 DIM X(N+1,5)
  7. 60 INPUT "Time Interval";TT
  8. 70 S1$="Time":S2$=S1$
  9. 110 REM ****************************************************************
  10. 120 REM * X(I,0) REAL, X(I,1) IMAGINARY                                *
  11. 130 REM * EVALUATE REAL, IMAGINARY IN LINES 190 - 269                  *
  12. 140 REM * FOR AUTOCORRELATION, AUTOSPEC. USE X(I,0), X(I,1)            *
  13. 150 REM * FOR CROSS SPECTRUM, CROSS CORRELATION                        *
  14. 160 REM * AND CONVOLUTION,                                             *
  15. 170 REM * USE X(I,0),X(I,1) AND X(I,2),X(I,3)                          *
  16. 180 REM ****************************************************************
  17. 190 REM
  18. 200 FOR J=0 TO N
  19. 210 IF J<N/2 THEN X(J,0)=1 ELSE X(J,0)=0
  20. 220 NEXT J
  21. 230 GOSUB 4100
  22. 240 GOTO 5000
  23. 250 REM
  24. 260 REM
  25. 270 PRINT
  26. 280 PRINT: PRINT "ITEMS 1-7 FOR X(I,0), X(I,1) ONLY":PRINT
  27. 290 PRINT "     1 -Forward Transform   9- Correlation"
  28. 300 PRINT "     2 -Inverse Transform   10-Convolution"
  29. 310 PRINT "     3 -List Real,Imaginary 11-Save Data in file"
  30. 320 PRINT "     4 -Sine,Cosine         12-Exit Program"
  31. 330 PRINT "     5 -Magnitude & Phase   13-Exchange Seq 1 & 2"
  32. 340 PRINT "     6 -Smoothing           14-Deseq 1=Seq1*Seq2"
  33. 350 PRINT "     7 -Windowing           15-"
  34. 360 PRINT "     8 -Power Spectrum      16-"
  35. 420 PRINT
  36. 430 INPUT "Type in selection by number";X
  37. 440 ON X GOTO 470,480,500,600,600,1450,1690,1790,2000,2310,1230,2770,460,450
  38. 450 FOR I=1 TO N:X(I,4)=X(I,0)*X(I,2)-X(I,1)*X(I,3): X(I,5)=X(I,0)*X(I,3)+X(I,2)*X(I,1):X(I,0)=X(I,4): X(I,1)=X(I,5):NEXT:GOTO 270
  39. 460 FOR I=1 TO N:X(I,4)=X(I,0):X(I,5)=X(I,1):X(I,0)=X(I,2):X(I,1)=X(I,3): X(I,2)=X(I,4):X(I,3)=X(I,5):NEXT:GOTO 270
  40. 470 REM ******** COMPUTE FORWARD TRANSFORM **********
  41. 471 INPUT "Transform Sequence 1 or Sequence 2";S$:S=INT(VAL(S$))
  42. 472 IF S<1 OR S>2 THEN PRINT "1 or 2 Only!":GOTO 471
  43. 473 IF S=1 THEN S=0 ELSE S=2
  44. 474 D=0:GOSUB 2480
  45. 475 IF S=0 THEN S1$="Frequency" ELSE S2$="Frequency"
  46. 476 A$="Fwd Transform":GOSUB 4000
  47. 477 GOTO 5000
  48. 480 ' ******* COMPUTE INVERSE TRANSFORM *****
  49. 481 INPUT "Transform Sequence 1 or Sequence 2";S$:S=INT(VAL(S$))
  50. 482 IF S<1 OR S>2 THEN PRINT "1 or 2 Only!":GOTO 481
  51. 483 IF S=1 THEN S=0 ELSE S=2
  52. 484 D=1:GOSUB 2480
  53. 485 IF S=0 THEN S1$="Time" ELSE S2$="Time"
  54. 486 A$="Inv Transform":GOSUB 4000
  55. 487 GOTO 5000
  56. 500 REM ******** DISPLAY EXPONENTIALS **************
  57. 501 INPUT "Display sequence 1 or 2";Q$
  58. 502 IF Q$="1" OR Q$="2" THEN GOTO 504
  59. 503 PRINT "Sequence 1 or 2 only!":GOTO 501
  60. 504 INPUT "Minimum,maximum display values";TMIN,TMAX
  61. 505 TMIN=INT(TMIN):TMAX=INT(TMAX):IF TMIN>TMAX THEN SWAP TMIN,TMAX
  62. 506 IF TMAX>N THEN TMAX=N
  63. 507 IF TMIN<1 THEN TMIN=1
  64. 508 IF Q$="1" THEN K=0 ELSE K=1
  65. 509 DISP$="####   ##.###^^^^   ##.###^^^^    ##.###^^^^"
  66. 510 HEAD$=" N      Value        Real          Imaginary"
  67. 511 IF K=0 THEN S$=LEFT$(S1$,1) ELSE S$=LEFT$(S2$,1)
  68. 512 IF S$="T" THEN KK=TT/N ELSE KK=N/TT
  69. 513 COUNT=0:PRINT HEAD$:PRINT
  70. 514 J=COUNT+TMIN
  71. 515 PRINT USING DISP$;J,KK*J,X(J,K),X(J,K+1)
  72. 516 COUNT=COUNT+1
  73. 517 IF COUNT MOD 20=0 THEN GOTO 519
  74. 518 IF COUNT+TMIN>TMAX THEN GOTO 530 ELSE GOTO 514
  75. 519 PRINT:PRINT "Press 'Q' to quit, any other key to go on";
  76. 520 Q$=INKEY$:IF Q$="" THEN GOTO 520
  77. 521 IF Q$="Q" OR Q$="q" THEN GOTO 5000 ELSE PRINT HEAD$:PRINT
  78. 522 GOTO 518
  79. 530 PRINT "Press any key to continue";
  80. 540 Q$=INKEY$:IF Q$="" THEN GOTO 540
  81. 550 GOTO 5000
  82. 560 PRINT J+K-G-1;TAB(6)X(J+K,0);TAB(25)X(J+K,1)
  83. 570 NEXT K
  84. 580 PRINT: PRINT "PRESS 'Q' TO QUIT, ANY OTHER KEY TO CONTINUE"
  85. 581 D$=INPUT$(1): IF D$="Q" THEN GOTO 270
  86. 582 PRINT:NEXT J
  87. 590 GOTO 270
  88. 600 REM ********** CALCULATE SINE, COSINE ****************
  89. 610 D=0:GOSUB 2480
  90. 620 X(1,2)=X(1,0):X(1,4)=X(1,1)
  91. 630 FOR I=2 TO N/2
  92. 640 X(I,2)=X(I,0)+X(N+2-I,0)
  93. 650 X(I,3)=X(N+2-I,1)-X(I,1)
  94. 660 X(I,4)=X(N+2-I,1)+X(I,1)
  95. 670 X(I,5)=X(I,0)-X(N+2-I,0)
  96. 680 NEXT I
  97. 690 REM ******* PRINT SIN/COS OF FIND MAG ***********
  98. 700 IF X=5 GOTO 880
  99. 710 PRINT:PRINT "REAL PART SINE, COSINE":PRINT
  100. 720 FOR J=0 TO N/2 STEP 10
  101. 730 PRINT "N" TAB(6)"COSINE" TAB(25)"SINE":PRINT
  102. 740 FOR K=1 TO 10
  103. 750 IF J+K>N/2 GOTO 270
  104. 760 PRINT J+K-1 TAB(6)X(J+K,2) TAB(25)X(J+K,3) 
  105. 770 NEXT K
  106. 780 GET E$:PRINT:NEXT J
  107. 790 PRINT:PRINT "IMAG PART, SINE, COSINE:P":PRINT
  108. 800 FOR J=0 TO N/2 STEP 10
  109. 810 PRINT "N" TAB(6)"COSINE"TAB(325)"SINE":PRINT
  110. 820 FOR K=1 TO 10
  111. 830 IF J+K>N/2 GOTO 850
  112. 840 PRINT J+K-1 TAB(6)X(J+K),4)TAB(25,)X(J+K,5)
  113. 850 NEXT K
  114. 860 PRINT:INPUT "PRESS <RET> TO CONTINUE:";D$:PRINT:NEXT J:GOTO 270
  115. 870 REM ******** EMD SINE COSINE ROUTINE **********
  116. 880 REM ****** ** START AMPLITUDE, PHASE  **********
  117. 890 FOR I=1 TO N/2
  118. 900 V=SQR(X(I,2)^2+X(I,3)^2)
  119. 910 EW=DQSQR(X(I,4)^2+X(I,5)^2)
  120. 920 IF ABS(X(I,2))<1E-12 THEN X(I,2)=1E-12
  121. 930 IF ABS(X(I,4))<1E-12 THEN X(I,4)=1E-12
  122. 940 Y=ATN(X(I,3)/X(I,2))*57.2958
  123. 950 IF X(I,2)<0 AND X(I,3)>0 THEN Y=Y+180
  124. 960 IF X(I,2)<0 AND X(I,3)<0 THEN Y=Y-180
  125. 970 X(I,2)=V:X(I,3)=Y
  126. 980 Y=ATN(X(I,5)/X(I,4))*57.2958
  127. 990 IF X(I,4)<0 AND X(I,5)>0 THEN Y=Y+180
  128. 1000 IF X(I,4)<0 AND X(I,5)<0 THEN Y=Y-180
  129. 1010 X(I,4)=W:X(I,5)=Y
  130. 1020 NEXT I
  131. 1030 PRINT CHR$(26):PRINT:PRINT "MAGNITUDE AND PHASE":PRINT
  132. 1040 PRINT "REAL PART":PRINT
  133. 1050 FOR J=0 TO N/2 STEP 10
  134. 1060 PRINT "N" TAB(6)"MAG" TAB(25) "PHASE":PRINT
  135. 1070 FOR K=1 TO 10
  136. 1080 IF J+K>N/2 GOTO 1100
  137. 1090 PRINT J+K-1 TAB(6)X(J+K,2) TAB(25)X(J+K,3)
  138. 1100 NEXT K
  139. 1110 PRINT:INPUT "PRESS <RET> TO CONTINUE";D$:PRINT:NEXT J
  140. 1120 PRINT: PRINT "IMAGINARY PART::":PRINT
  141. 1130 FOR J=0 TO N/2 STEP 10
  142. 1140 PRINT "N" TAB(6) "MAG" TAB(25) "PHASE":PRINT
  143. 1150 FOR K=1 TO 10
  144. 1160 IF J+K>N/2 GOTO 1180
  145. 1170 PRINT J+K-1 TAB(6) X(J+K,4) TAB(25) X(J+K,5)
  146. 1180 NEXT K
  147. 1190 PRINT:INPUT "PRESS <RET> TO CONTINUE";D$:PRINT:NEXT J
  148. 1200 GOTO 270
  149. 1210 REM ******* END MAG,PHASE ******
  150. 1220 REM ****** OUTPUT DATA FILE ****
  151. 1230 PRINT CHR$(26):PRINT:PRINT "INSTRUCTIONS TO SAVE DATA IN DATA FILE"
  152. 1240 PRINT "SAVE X OR MAGNITUDE OR PHASE":PRINT
  153. 1250 PRINT  "X IS X(N),X(K) , SPEC.,CONV.,CORR.":PRINT
  154. 1260 PRINT "0=X(I,0) REAL"
  155. 1270 PRINT "1=X(I,1) IMAGINARY"
  156. 1280 PRINT "2=MAGNITUDE, REAL PART"
  157. 1290 PRINT "3=PHASE, REAL PART"
  158. 1300 PRINT "4=MAGNITUDE, IMAGINARY PART"
  159. 1310 PRINT "5=PHASE, IMAGINARY PART"
  160. 1320 INPUT R
  161. 1330 Q=1
  162. 1340 IF R>1 THEN Q=2
  163. 1350 DIM A(N/Q)
  164. 1360 FOR I=1 TO N/Q:A(I)=X(I,R):NEXT
  165. 1370 INPUT "NAME OF FILE TO SAVE DATA";F$
  166. 1371 OPEN "O",1,F$
  167. 1372 FOR I=1 TO N/Q
  168. 1373 PRINT #1,A(I)
  169. 1374 NEXT I
  170. 1375 CLOSE #1
  171. 1380 PRINT CHR$(13):PRINT "DATA FILED"
  172. 1390 GOTO 270
  173. 1400 REM ********* END DATA OUTPUT ************
  174. 1440 REM ******** SMOOTHING ************
  175. 1450 PRINT:PRINT "Sequence Smoothing":PRINT
  176. 1451 INPUT "Sequence to Smooth (1/2)";S
  177. 1452 IF S=1 THEN S=0:GOTO 1460
  178. 1453 IF S=2 THEN GOTO 1460
  179. 1454 PRINT "Sequence 1 or 2 only!":GOTO 1451
  180. 1460 PRINT "Type 1 for Low-Pass"
  181. 1470 PRINT "Type 2 for High-Pass"
  182. 1480 INPUT Z:Z=INT(Z)
  183. 1481 IF Z<1 OR Z>2 THEN GOTO 1460
  184. 1482 IF S=0 AND Z=1 THEN SMO1$="Low-Pass"
  185. 1483 IF S=0 AND Z=2 THEN SMO1$="High-Pass"
  186. 1484 IF S=2 AND Z=1 THEN SMO2$="Low-Pass"
  187. 1485 IF S=2 AND Z=2 THEN SMO2$="High-Pass"
  188. 1486 A$="Smoothing"
  189. 1490 ON Z GOTO 1500, 1590
  190. 1500 X(1,5)=.25*X(N,S)+.5*X(I1,S)+.25*X(2,S)
  191. 1510 X(N,5)=.25*X(N-1,S)+.5*X(1,S)+.25*X(2,S)
  192. 1520 FOR J=2 TO N-1:X(J,5)=.25*X(J-1,S)+.5*X(J,S)+.25*X(J+1,S):NEXT
  193. 1530 FOR J=1 TO N:X(J,S)=X(J,5):NEXT
  194. 1540 X(1,T5)=.25*X(N,S+1)+.5*JX(1,S+1)+.25*X(2,S+1)
  195. 1550 X(N,5)=.25*X(N-1,S+1)+.5*X(N,S+1)+.25*X(1,S+1)
  196. 1560 FOR J=2 TO N-1:X(J,5)=.25*X(J-1,S)+.5*X(J,S+1)+.25*X(J+1,S+1):NEXT J
  197. 1570 FOR J=1 TO N:X(J,S+1)=X(J,5):NEXT J
  198. 1575 GOSUB 4000
  199. 1580 GOTO 5000
  200. 1590 X(1,5)=-.25*X(N,S)+.5*X(1,S)-.25*X(2,S)
  201. 1600 X(N,5)=-.25*X(N-1,S)+.5*X(N,S)-.25*X(1,S)
  202. 1610 FOR J=2 TO N-1:X(J,5)=-.25*X(J-1,S+1)+.5*X(J,S)-.25*X(J+1,S):NEXT
  203. 1620 FOR J=1 TO N:X(J,S)=X(J,5):NEXT J
  204. 1630 X(1,5)=-.25*X(N,S+1)+.5*X(1,S+1)-.25*X(2,S+1)
  205. 1640 X(N,5)=-.25*X(N-1,S+1)+.5*X(N,S+1)-.25*X(2,S+1)
  206. 1650 FOR J=2 TO N-1:X(J,5)=-.25*X(J-1,S+1)+.5*X(J,S+1)-.25*X(J+1,S+1):NEXT J
  207. 1660 FOR J=1 TO N:X(J,S+1)=X(J,5):NEXT J
  208. 1665 GOSUB 4000
  209. 1670 GOTO 5000
  210. 1680 REM ******** WINDOWING ************
  211. 1690 PRINT:PRINT: PRINT "Sequence Window":PRINT
  212. 1691 INPUT "Sequence to Window (1/2)";S
  213. 1692 IF S=1 THEN S=0:GOTO 1700
  214. 1693 IF S=2 THEN GOTO 1700
  215. 1694 PRINT "Sequence 1 or 2 only!":GOTO 1691
  216. 1700 PRINT "Type 1 FOR Hanning"
  217. 1710 PRINT "Type 2 FOR Hamming"
  218. 1720 INPUT Q
  219. 1721 Q=INT(Q):IF Q<1 THEN GOTO 1700
  220. 1722 IF Q>2 THEN GOTO 1700
  221. 1723 IF Q=1 AND S=0 THEN WIN1$="Hanning"
  222. 1724 IF Q=2 AND S=0 THEN WIN1$="Hamming"
  223. 1725 IF Q=1 AND S=2 THEN WIN2$="Hanning"
  224. 1726 IF Q=2 AND S=2 THEN WIN2$="Hamming"
  225. 1727 A$="Windowing"
  226. 1730 IF Q=2 THEN Q=.8519
  227. 1740 FOR I=1 TO N
  228. 1750 X(I,S)=X(I,S)*(1-Q*COS(2*PI*(I-1)/N))
  229. 1760 X(I,S+1)=X(I,S+1)*(1-Q*COS (2*PI*(I-1)/N))
  230. 1770 NEXT I
  231. 1771 GOSUB 4000
  232. 1780 GOTO 5000
  233. 1790 REM ******** POWER SPECTRUM ***********
  234. 1800 REM ******* AUTO SPEC. USE X(I,0),X(I,1) ***********
  235. 1810 REM ****** CROSS SPEC. USE X(I,0),X(I,1) AND X(I,2),X(I,3) ********
  236. 1820 PRINT CHR$(26):PRINT:PRINT "TWO-SIDED POWER SPECTRUM":PRINT
  237. 1830 PRINT "TYPE 1 FOR SPECTRUM OF SEQUENCE ONE"
  238. 1840 PRINT "TYPE 2 FOR SPECTRUM OF SEQUENCE TWO"
  239. 1850 PRINT "TYPE 3 FOR CROSS SPECTRUM"
  240. 1860 INPUT F:PRINT
  241. 1870 ON F GOTO 1890,1880,1920
  242. 1880 FOR I=1 TO N: X(I,0)=X(I,2):X(I,1)=X(I,3):NEXT
  243. 1890 D=0:GOSUB 2480
  244. 1900 FOR I=1 TO N:X(I,0)=X(I,0)*X(I,0)+X(I,1)*X(I,1):X(I,1)=0:NEXT
  245. 1910 PRINT:PRINT "AUTOSPECTRUM":PRINT:GOTO 1980
  246. 1920 FOR I=1 TO N:X(I,4)=X(I,0):X(I,5)=X(I,1):X(I,0)=X(I,2):X(I,1)=X(I,3):NEXT
  247. 1930 D=0:GOSUB 2480
  248. 1940 FOR I=1 TO N:X(I,2)=X(I,0):X(I,3)=X(I,1):X(I,0)=X(I,4):X(I,1)=X(I,5):NEXT
  249. 1950 D=0:GOSUB 2480
  250. 1960 FOR I=1 TO N:X(I,4)=X(I,0)*X(I,2)+X(I,1)*X(I,3):X(I,5)=X(I,1)*X(I,2)-X(I,0)*X(I,3):X(I,0)=X(I,4):X(I,1)=X(I,5):NEXT
  251. 1970 PRINT:PRINT "CROSS SPECTRUM":PRINT
  252. 1980 PRINT "TYPE 3 TO LIST POWER SPECTRUM":PRINT:GOTO 290
  253. 1990 REM ******* CORRELATION *************
  254. 2000 PRINT CHR$(26):PRINT:PRINT "CORRELATION"
  255. 2010 PRINT: PRINT "FOR LINEAR CORRELATION, DOUBLE THE VALUE OF N AND FILL IN ";"ZEROS FROM N/2 TO N-1 IN X(N) BEFORE PROCEEDING"
  256. 2020 PRINT:PRINT "TYPE 1 FOR AUTOCORRELATION OF SEQUENCE X(N) IN X(I,0),X(I,1)"
  257. 2030 PRINT "TYPE 2 FOR AUTOCORRELATION OF SEQUENCE X(N) IN X(I,2),X(I,3)."
  258. 2040 PRINT "TYPE 3 FOR CROSS-CORRELATION"
  259. 2050 INPUT C
  260. 2060 PRINT:PRINT "TYPE 1 FOR CORRELATION:"
  261. 2070 PRINT "TYPE 2 FOR COVARIANCE."
  262. 2080 INPUT Q
  263. 2090 PRINT:PRINT "TYPE 1 IF LINEAR"
  264. 2100 PRINT "TYPE 2 IF CIRCULAR"
  265. 2110 INPUT E1
  266. 2120 IF Q=2 THEN GOSUB 2280
  267. 2130 ON C GOTO 2150,2140,2160
  268. 2140 FOR I=1 TO N:X(I,0)=X(I,2):X(I,1)=X(I,3):NEXT
  269. 2150 D=0:GOSUB 2480:GOSUB 2200:D=1:GOSUB 2480:GOSUB 2210:GOTO 2170
  270. 2160 D=0:GOSUB 2480:GOSUB 2260:D=0:GOSUB 2480:GOSUB 2270:D=1:GOSUB 2480:GOSUB 2210
  271. 2170 PRINT: ON Q GOTO 2180,2190
  272. 2180 PRINT "TYPE 3 TO LIST CORRELATION":PRINT:GOTO 290
  273. 2190 PRINT "TYPE 3 TO LIST COVARIANCE":PRINT:GOTO 290
  274. 2200 FOR I=1 TO N:X(I,0)=X(I,0)^2+X(I,1)^2:X(I,1)=0:NEXT
  275. 2210 IF E1=2 GOTO 2250
  276. 2220 FOR I=1 TO N:X(I,0)=X(I,0)*2:X(I,1)=X(I,1)*2:NEXT
  277. 2230 FOR I=1 TO N/2:X(I+N/2,4)=X(I,0):X(I,4)=X(I+N/2,0):X(I+N/2,5)=X(I,1):X(I,5)=X(I+N/2,1):NEXT
  278. 2240 FOR I=1 TO N:X(I,0)=X(I,4):X(I,1)=X(I,5):NEXT
  279. 2250 RETURN
  280. 2260 FOR I=1 TO N:X(I,4)=X(I,0):X(I,5)=X(I,1):X(I,0)=X(I,2):X(I,1)=X(I,3):NEXT:RETURN
  281. 2270 FOR I=1 TO N:X(I,2)=X(I,0)*X(I,4)+X(I,1)*X(I,5):X(I,3)=X(I,0)*X(I,5)-X(I,1)*X(I,4):X(I,0)=X(I,2):X(I,1)=X(I,3):NEXT:RETURN
  282. 2280 U=N/(3-E1):AA=0:BB=0:CC=0:DD=0
  283. 2290 FOR I=1 TO U:AA=AA+X(I,0):BB=BB+X(I,1):CC=CC+X(I,2):DD=DD+X(I,3):NEXT
  284. 2300 FOR I=1 TO U:X(I,0)=X(I,0)-AA/U:X(I,1)=X(I,1)-BB/U:X(I,2)=X(I,2)-CC/U:X(I,3)=X(I,3)=-DD/U:NEXT:RETURN
  285. 2310 REM ********* CONVOLUTION ************
  286. 2320 PRINT CHR$(26):PRINT:PRINT "CONVOLUTION":PRINT
  287. 2330 PRINT "SEQUENCE 1 IN X(I,0),X(I,1)"
  288. 2340 PRINT "SEQUENCE 2 IN X(I,3),X(I,4)":PRINT
  289. 2350 PRINT "FOR LINEAR CONVOLUTION, DOUBLE THE VALUE OF N AND ";"ARGUMENT WITH ZEROS IN BOTH SEQUENCES"
  290. 2360 PRINT:PRINT "TYPE 1 IF LINEAR"
  291. 2370 PRINT "TYPE 2 IF CIRCULAR"
  292. 2380 INPUT QQ
  293. 2390 D=0:GOSUB 2480:GOSUB 2440:GOSUB 2480:GOSUB 2450:D=1:GOSUB 2480:GOSUB 2460
  294. 2400 PRINT:PRINT TYPE 1 TO "TYPE 1 TO MULTIPLY FOR N"
  295. 2410 GET A$:PRINT A$
  296. 2420 IF A$="1" THEN: FOR I=1 TO N:X(I,0)=X(I,0)*N:X(I,1)=X(I,1)*N:NEXT
  297. 2430 PRINT:PRINT "TYPE 3 TO LIST CONVOLUTION OF X(1,N) AND X2(N).":PRINT:GOTO 290
  298. 2440 FOR I=1 TO N:X(I,4)=X(I,0):X(I,5)=X(I,1):X(I,0)=X(I,2):X(I,1)=X(I,3):NEXT:RETURN
  299. 2450 FOR I=1 TO N:X(I,2)=X(I,0)*X(I,4)-X(I,1)*X(I,5):X(I,3)=X(I,0)*X(I,5)+X(I,4)*X(I,1):X(I,0)=X(I,2):X(I,1)=X(I,3):NEXT:RETURN
  300. 2460 IF QQ=1 THEN: FOR I=1 TO N:X(I,0)=2*X(I,0):X(I,1)=2*X(I,1):NEXT:RETURN
  301. 2470 RETURN
  302. 2480 REM ***** FFT ROUTINE, COMPLEX DATA ARRAY ******
  303. 2490 REM ****** X(I,0) REAL, X(I,1) IMAGINARY  ******
  304. 2500 REM ****** D=0, FORWARD. D-=1, REVERSE **********
  305. 2505 REM ****** S=0, SEQUENCE 1. S=2, SEQUENCE 2 **********
  306. 2510 N2=N/2:N1=N-1:J=1
  307. 2520 FOR I=1 TO N1
  308. 2530 IF I>=J THEN 2550
  309. 2540 T1=X(J,S):T2=X(J,S+1):X(J,S)=X(I,S):X(J,S+1)=X(I,S+1):X(I,S)=T1:X(I,S+1)=T2
  310. 2550 K=N2
  311. 2560 IF K>=J THEN 2590
  312. 2570 J=J-K:K=K/2
  313. 2580 GOTO 2560
  314. 2590 J=J+K
  315. 2600 NEXT I
  316. 2610 S1=-1
  317. 2620 IF D=0 THEN 2640
  318. 2630 S1=1
  319. 2640 FOR L=1 TO M
  320. 2650 L1=2^L:L2=L1/2:U1=1:U2=0:W1=COS(PI/L2):W2=S1*SIN(PI/L2)
  321. 2660 FOR J=1 TO L2
  322. 2670 FOR I=J TO N STEP L1
  323. 2680 I1=I+L2
  324. 2690 V1=X(I1,S)*U1-X(I1,S+1)*U2:V2=X(I1,S+1)*U1+X(I1,S)*U2
  325. 2700 X(I1,S)=X(I,S)-V1:X(I1,S+1)=X(I,S+1)-V2:X(I,S)=X(I,S)+V1:X(I,S+1)=X(I,S+1)+V2
  326. 2710 NEXT I
  327. 2720 U3=U1:U4=U2:U1=U3*W1-U4*W2:U2=U4*W1+U3*W2
  328. 2730 NEXT J,L
  329. 2740 IF D=1 THEN 2760
  330. 2750 FOR I=1 TO N:X(I,S)=X(I,S)/N:X(I,S+1)=X(I,S+1)/N:NEXT
  331. 2760 RETURN
  332. 2770 PRINT:PRINT "END":END
  333. 3000 ' File Handling Routines - R. B. Kolbly 3-6-85
  334. 3010 ' Load a file into array
  335. 3020 INPUT "Name of file to load (<cr> for directory)";F$
  336. 3030 IF LEN(F$)=0 THEN FILES:GOTO 3020
  337. 3040 IF RIGHT$(F$,1)=":" AND LEN(F$)=2 THEN FILES F$:GOTO 3020
  338. 3050 INPUT "Sequence to load";S$:S=INT(VAL(S$))
  339. 3060 IF S=1 THEN K=0:GOTO 3090
  340. 3070 IF S=2 THEN K=2:GOTO 3090
  341. 3080 PRINT "Sequence 1 or 2 only!":GOTO 3050
  342. 3090 INPUT "Real or imaginary part (R/I)";S$:S$=LEFT$(S$,1)
  343. 3100 IF S$="R" OR S$="r" THEN GOTO 3130
  344. 3110 IF S$="I" OR S$="i" THEN K=K+1:GOTO 3130
  345. 3120 GOTO 3090
  346. 3125 OPEN "I",#1,F$
  347. 3130 FOR J=0 TO N
  348. 3140 IF EOF(1) THEN 3160
  349. 3150 INPUT #1,D,X(N,K):GOTO 3170
  350. 3160 NULL=NULL+1
  351. 3170 NEXT J
  352. 3180 IF EOF(1) AND NULL=0 THEN GOTO 3270
  353. 3190 IF NULL=0 THEN GOTO 3230
  354. 3200 PRINT "The number of data points in the file did not fill the array."
  355. 3210 PRINT USING "The last ### points were loaded with zero";NULL
  356. 3220 GOTO 3270
  357. 3230 INPUT #1,D,E:NULL=NULL+1
  358. 3240 IF EOF(1) THEN 3260
  359. 3250 GOTO 3230
  360. 3260 PRINT USING "File longer than array by ### elements!";NULL
  361. 3270 CLOSE #1:A$="Loaded "+F$
  362. 3280 GOSUB 4000
  363. 3290 RETURN
  364. 3500 ' Save data in file compatable with PC-PLOT. Data are
  365. 3510 ' automatically scaled to the time/frequency values used.
  366. 3520 INPUT "Name of file to save data";F$
  367. 3530 IF RIGHT$(F$,1)=":" AND LEN(F$)=2 THEN FILES F$:GOTO 3520
  368. 3540 IF LEN(F$)=0 THEN FILES:GOTO 3520
  369. 3550 INPUT "Sequence to save (1/2)";S$:S$=INT(VAL(LEFT$(S$,1)))
  370. 3560 IF S=1 THEN K=0:GOTO 3590
  371. 3570 IF S=2 THEN K=2:GOTO 3590
  372. 3580 PRINT "Sequence 1 or 2 only!":GOTO 3550
  373. 3590 INPUT "Real or Imaginary (R/E) component";S$:S$=LEFT$(S$,1)
  374. 3600 IF S$="R" OR S$="r" THEN GOTO 3630
  375. 3610 IF S$="I" OR S$="i" THEN K=K+1:GOTO 3630
  376. 3620 GOTO 3590
  377. 3630 IF K<3 THEN STATE=STATE1 ELSE STATE=STATE2
  378. 3635 OPEN "O",#1,F$
  379. 3640 FOR J=0 TO N
  380. 3650 IF STATE=0 THEN X1=J*T/N ELSE X1=J*N/T
  381. 3660 WRITE #1,X1,X(J,K)
  382. 3670 NEXT J
  383. 3680 CLOSE #1:A$="Saved Seq "+STR$(S)+" in "+F$
  384. 3690 GOSUB 4000
  385. 3700 RETURN
  386. 4000 IF S>=2 THEN GOTO 4060:' MAINTAIN ACTION ARRAY
  387. 4010 FOR J=4 TO 0 STEP -1
  388. 4020 A$(J+1)=A$(J)
  389. 4030 NEXT J
  390. 4040 A$(0)=A$
  391. 4050 GOTO 4100:' RETURN
  392. 4060 FOR J=4 TO 0 STEP -1
  393. 4070 B$(J+1)=B$(J)
  394. 4080 NEXT J
  395. 4090 B$(0)=A$:' RETURN
  396. 4100 FOR J=0 TO 3
  397. 4110 MMX(0,J)=X(0,J):' Minimum Values
  398. 4120 MMX(1,J)=X(1,J):' Maximum values
  399. 4130 NEXT J
  400. 4140 FOR J=1 TO N
  401. 4150 FOR K=0 TO 3
  402. 4160 IF X(J,K)<MMX(0,K) THEN MMX(0,K)=X(J,K)
  403. 4170 IF X(J,K)>MMX(1,K) THEN MMX(1,K)=X(J,K)
  404. 4180 NEXT K
  405. 4190 NEXT J
  406. 4200 RETURN
  407. 5000 ' MENU DISPLAY SUBROUTINE
  408. 5010 CLS:KEY OFF:LOCATE 1,20:PRINT "Lockheed-California Co. Signal Analyzer"
  409. 5020 LOCATE 2,22:PRINT "by Richard B. Kolbly, Dept. 72-52"
  410. 5030 LOCATE 4,33:PRINT USING "#### Steps";N
  411. 5040 LOCATE 5,6:PRINT "Sequence #1":LOCATE 5,52:PRINT "Sequence #2"
  412. 5050 LOCATE 7,7:PRINT "Source:":LOCATE 7,53:PRINT "Source:"
  413. 5060 LOCATE 7,18:PRINT F1$:LOCATE 7,65:PRINT F2$
  414. 5070 LOCATE 8,7:PRINT "State:":LOCATE 8,53:PRINT "State:"
  415. 5080 LOCATE 8,18:PRINT S1$:LOCATE 8,65:PRINT S2$
  416. 5090 LOCATE 9,7:PRINT "Windowing:":LOCATE 9,53:PRINT "Windowing:"
  417. 5100 LOCATE 9,18:PRINT WIN1$:LOCATE 9,65:PRINT WIN2$
  418. 5110 LOCATE 10,7:PRINT "Smoothing:":LOCATE 10,53:PRINT "Smoothing:"
  419. 5120 LOCATE 10,18:PRINT SMO1$:LOCATE 10,65:PRINT SMO2$
  420. 5130 LOCATE 12,11:PRINT "  Real      Imaginary"
  421. 5140 LOCATE 12,56:PRINT "  Real      Imaginary"
  422. 5150 LOCATE 14,1: PRINT USING "Maximum   ##.##^^^^  ##.##^^^^";MMX(1,0),MMX(1,1)
  423. 5160 LOCATE 14,46:PRINT USING "Maximum   ##.##^^^^  ##.##^^^^";MMX(1,2),MMX(1,3)
  424. 5170 LOCATE 15,1: PRINT USING "Minimum   ##.##^^^^  ##.##^^^^";MMX(0,0),MMX(0,1)
  425. 5180 LOCATE 15,46:PRINT USING "Minimum   ##.##^^^^  ##.##^^^^";MMX(0,2),MMX(0,3)
  426. 5190 FOR J=0 TO 5
  427. 5200 LOCATE 17+J,7:PRINT A$(J)
  428. 5210 LOCATE 17+J,52:PRINT B$(J)
  429. 5220 NEXT J
  430. 5230 Q$=INKEY$:IF Q$="" THEN GOTO 5230
  431. 5240 GOTO 270
  432.