home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / tech / ee6 / filsyp.bas < prev    next >
Encoding:
BASIC Source File  |  1989-01-22  |  14.7 KB  |  430 lines
  1. 10 REM               LOWPASS SYNTHESIS PROGRAM  FILSYP.BAS
  2. 20 REM               LINKED FROM DESIGN PROGRAM....FILDES.BAS
  3. 30 REM
  4. 40 Z=0:HCP=0:K$="N"
  5. 50 PRINT "NOW RUNNING THE LOWPASS PROTOTYPE SYNTHESIS PROGRAM"
  6. 60 OPEN "I",1,"PROTO"
  7. 70 INPUT #1,R,G,HCP,F1,F2,A1,Z
  8. 80 IF HCP=1 THEN K$="Y"
  9. 90 IF Z=1 THEN INPUT #1,N:Z$="Y":GOTO 120
  10. 100 Z$="N"
  11. 110 INPUT #1,A2
  12. 120 IF R<3 THEN INPUT #1,FC,FS:GOTO 140
  13. 130 INPUT #1,BW,SW,FCNTR
  14. 140 IF EOF(1) THEN CLOSE #1
  15. 150 GOSUB 3650
  16. 160 DEFDBL D,H:DEFINT I
  17. 170 DIM F(5),X(5),P(5),Z(5),Q(5),DO(30),DS(30),DA(30),DB(30),DC(30)
  18. 180 DIM D(30),V$(5),PR(5)
  19. 190 DE=.4342944819#:DEF FN LGT(X)=LOG(X)*DE:DPI=3.141592654000005#
  20. 200 AA=0:H1$=Z$
  21. 210 ON G GOSUB 500,910,1280
  22. 220 IF K$="Y" THEN GOSUB 3230
  23. 230 IF Z$="N" GOTO 260
  24. 240 IF K$="Y" THEN LPRINT:LPRINT "Attenuation of this "R$" at FS will be: "A"db"
  25. 250 PRINT:PRINT "Attenuation of this "R$" at FS will be: "A"db":GOTO 360
  26. 260 IF R>2 THEN NX=2*N:GOTO 280
  27. 270 NX=N
  28. 280 IF NX=1 THEN S$="st"
  29. 290 IF NX=2 THEN S$="nd"
  30. 300 IF NX=3 THEN S$="rd"
  31. 310 IF NX>3 THEN S$="th"
  32. 320 PRINT:PRINT "This "R$" will require a"NX S$" Order implementation"
  33. 330 IF K$="Y" THEN LPRINT:LPRINT "This "R$" will require a"NX S$" Order Implementation"
  34. 340 PRINT:PRINT "Actual Attenuation at FS will be "A"db"
  35. 350 IF K$="Y" THEN LPRINT:LPRINT "Actual Attenuation at FS will be "A"db"
  36. 360 IF N>10 THEN PRINT:PRINT "PROGRAM CANNOT ACCOMODATE THIS HIGH OF AN ORDER!!":GOTO 400
  37. 370 IF A<A2 THEN PRINT:PRINT "ORDER IS TOO HIGH!!!":GOTO 400
  38. 380 PRINT:PRINT: INPUT "IS THIS SATISFACTORY";H$:H$=LEFT$(H$,1)
  39. 390 GOTO 410
  40. 400 PRINT:PRINT "Re-Enter the entire filter.....":GOTO 480
  41. 410 IF H$="N" THEN PRINT "RE-ENTER ENTIRE FILTER......":GOTO 480
  42. 420 IF H$<>"Y" THEN GOTO 380
  43. 430 IF H$="Y" THEN ON G GOSUB 590,990,2620
  44. 440 IF R=1 GOTO 470
  45. 450 PRINT:PRINT "Now Transforming the Lowpass Prototype for the Required "R$
  46. 460 RUN "FILTRP.EXE"
  47. 470 PRINT:PRINT"DESIGN COMPLETE......"
  48. 472 PRINT"     PRESS T - TRY ANOTHER FILTER"
  49. 474 PRINT"           R - CALCULATE GAIN AND PHASE RESPONSE OF THIS FILTER"
  50. 476 PRINT"           E - END (EXIT TO OPERATING SYSTEM)"
  51. 478 INPUT V$
  52. 480 IF V$="T" OR V$="t" THEN RUN "FILDES.EXE"
  53. 482 IF V$="R" OR V$="r" THEN RUN "FILPLT.EXE"
  54. 484 IF V$="E" OR V$="e" THEN SYSTEM
  55. 486 GOTO 472
  56. 490 REM END
  57. 500 REM BUTTERWORTH ORDER OR ATT
  58. 510 IF H1$="N" THEN 540
  59. 520 A2=10*FN LGT(1+(10^(.1*A1)-1)*(F2/F1)^(2*N)):A=A2
  60. 530 GOTO 570
  61. 540 N=FN LGT((10^(.1*A2)-1)/(10^(.1*A1)-1))/(2*FN LGT(F2/F1))
  62. 550 IF INT(N)<>N THEN N=INT(N)+1
  63. 560 A=10*FN LGT(1+(10^(.1*A1)-1)*(F2/F1)^(2*N))
  64. 570 RETURN
  65. 580 REM BUTTERWORTH FC & Q
  66. 590 M=INT (N/2)
  67. 600 F3=F1/(((10^(.1*A1)-1)/(10^.3-1))^(1/(2*N)))
  68. 610 FOR I=1 TO M:F(I)=F3:NEXT I
  69. 620 IF N>2*M THEN F(M+1)=F3
  70. 630 IF N=2*M THEN FOR I=1 TO M:O(I)=(DPI/(2*N))*(2*I-1):NEXT I
  71. 640 IF N<>2*M THEN FOR I=1 TO M:O(I)=DPI*I/N:NEXT I
  72. 650 FOR I=1 TO M:Q(I)=1/(2*COS(O(I))):NEXT I
  73. 660 IF K$="Y" THEN GOSUB 3030
  74. 670 OPEN "O",2,"IDATA"
  75. 680 PRINT #2,F1,0,M
  76. 690 IF M*2<>N THEN PRINT #2,1,F(M+1) ELSE PRINT #2,0
  77. 700 FOR I=1 TO M: PRINT#2, F(I),Q(I):NEXT I
  78. 710 CLOSE 2
  79. 720 IF R=1 AND K$="Y" THEN LPRINT:LPRINT "Required Resonant Frequencies:"
  80. 730 IF R=1 THEN PRINT:PRINT "Required Resonant Frequencies:":GOTO 750
  81. 740 PRINT:PRINT "Normalized Prototype Parameters:"
  82. 750 PRINT "    F          Q"
  83. 760 IF K$="Y" THEN LPRINT "    F          Q"
  84. 770 IF R=1 GOTO 840
  85. 780 FOR I=1 TO M : PRINT F(I),Q(I)
  86. 790 IF K$="Y" THEN LPRINT F(I),Q(I)
  87. 800 NEXT I
  88. 810 IF N/2 <> M THEN PRINT F(M+1) ELSE GOTO 890
  89. 820 IF K$="Y" THEN LPRINT F(M+1)
  90. 830 GOTO 890
  91. 840 OPEN "O",3,"PLTDATA"
  92. 841 IF N/2 <> M THEN PRINT #3,1,1,M+1 ELSE PRINT #3,1,1,M
  93. 843 FOR I=1 TO M:PRINT F(I)*FC,Q(I)
  94. 850 IF K$="Y" THEN LPRINT F(I)*FC,Q(I)
  95. 855 PRINT #3,F(I)*FC,Q(I)
  96. 860 NEXT I
  97. 870 IF N/2<>M THEN PRINT F(M+1)*FC ELSE 888
  98. 880 IF K$="Y" THEN LPRINT F(M+1)*FC
  99. 885 PRINT #3,F(M+1)*FC,0
  100. 888 CLOSE 3
  101. 890 RETURN
  102. 900 REM CHEBYCHEV ORDER  OR ATT
  103. 910 Y=F2/F1:YY=LOG(Y+SQR(Y^2-1))
  104. 920 IF H1$="Y" THEN 960
  105. 930 E=10^(.1*A1)-1:F=10^(.1*A2)-1
  106. 940 X=SQR(F/E):XX=LOG(X+SQR(X^2-1))
  107. 950 N=XX/YY:IF INT(N)<>N THEN N=INT(N)+1
  108. 960 T=(EXP(N*YY)+EXP(-N*YY))/2:E=10^(.1*A1)-1
  109. 970 A=10*FN LGT(1+E*T^2):IF H1$="Y" THEN A2=A
  110. 980 RETURN
  111. 990 REM CHEBYCHEV F & Q
  112. 1000 NN=N:V=0
  113. 1010 GOSUB 1960
  114. 1020 IF K$="Y" THEN GOSUB 3090
  115. 1030 IF R=1 AND K$="Y" THEN LPRINT:LPRINT "Required Resonant Frequencies are:"
  116. 1040 IF R=1 THEN PRINT:PRINT "Required Resonant Frequencies are:":GOTO 1070
  117. 1050 PRINT:PRINT "Normalized Prototype Parameters are:"
  118. 1060 IF K$="Y" THEN LPRINT:LPRINT "Normalized Prototype Prameters are:"
  119. 1070 PRINT "     F         Q"
  120. 1080 IF K$="Y" THEN LPRINT "     F         Q"
  121. 1090 IF R=1 GOTO 1160
  122. 1100 FOR I=1 TO INT(N/2):PRINT P(I),Q(I)
  123. 1110 IF K$="Y" THEN LPRINT P(I),Q(I)
  124. 1120 NEXT I
  125. 1130 IF INT(N/2)<>N/2 THEN PRINT F(INT(N/2)+1) ELSE GOTO 1210
  126. 1140 IF K$="Y" THEN LPRINT F(INT(N/2)+1)
  127. 1150 GOTO 1210
  128. 1160 OPEN "O",3,"PLTDATA"
  129. 1162 IF N/2<>INT(N/2) THEN PRINT #3,1,2,INT(N/2)+1 ELSE PRINT #3,1,2,INT(N/2)
  130. 1167 FOR I=1 TO INT(N/2):PRINT P(I)*FC,Q(I)
  131. 1170 IF K$="Y" THEN LPRINT P(I)*FC,Q(I)
  132. 1175 PRINT #3,P(I)*FC,Q(I)
  133. 1180 NEXT I
  134. 1190 IF INT(N/2)<>N/2 THEN PRINT F(INT(N/2)+1)*FC ELSE GOTO 1207
  135. 1200 IF K$="Y" THEN LPRINT F(INT(N/2)+1)*FC
  136. 1205 PRINT #3,F(INT(N/2)+1)*FC,0
  137. 1207 CLOSE 3
  138. 1210 OPEN "O",2,"IDATA"
  139. 1220 PRINT #2,F1,0,INT(N/2)
  140. 1230 IF N/2<>INT (N/2) THEN PRINT #2,1,F(INT(N/2)+1)ELSE PRINT #2,0
  141. 1240 FOR I=1 TO N/2: PRINT #2, P(I),Q(I): NEXT I
  142. 1250 CLOSE 2
  143. 1260 RETURN
  144. 1270 REM ELLIPTIC ORDER OR ATT
  145. 1280 HE=10^(.1*A1)-1:HX=F2/F1
  146. 1290 PRINT:PRINT "BE PATIENT.....ELLIPTICS TAKE A WHILE!!!"
  147. 1300 H=SQR(1-1/HX/HX):GOSUB 1550
  148. 1310 H3=H4
  149. 1320 H =1/HX:GOSUB 1550
  150. 1330 H0=H4
  151. 1340 IF H1$="Y" THEN 1460
  152. 1350 HL=SQR((10^(.1*A2)-1)/HE)
  153. 1360 IF 1/HL<.001 THEN GOSUB 3260
  154. 1370 IF AA=1 THEN 1540
  155. 1380 H=1/HL
  156. 1390 GOSUB 1550
  157. 1400 H1=H4
  158. 1410 H=SQR(1-1/HL/HL)
  159. 1420 IF H=1 THEN H=1!
  160. 1430 GOSUB 1550
  161. 1440 H2=H4:H=1/HX:H4=H0
  162. 1450 N=INT(H2/H1*H4/H3)+1
  163. 1460 NN=0:HR=1
  164. 1470 IF N=2*INT(N/2) THEN NN=1
  165. 1480 FOR I=1 TO INT(N/2): GOSUB 1820:NEXT I
  166. 1490 FOR I=1 TO N/2: HR=HR*(1-Z(I)^2)/(1-X(I)^2): NEXT I
  167. 1500 HC=1/HR:X=HX:HR=HC*X^(1-NN)
  168. 1510 FOR I=1 TO N/2:HR=HR*(X^2-Z(I)^2)/(X^2-X(I)^2):NEXT I
  169. 1520 A=10*FN LGT(1+HE*HR^2)
  170. 1530 IF H1$="Y" THEN A2=A
  171. 1540 RETURN
  172. 1550 REM CALCULATE H4 COMPLETE INTEGRAL
  173. 1560 IF H=1 THEN DA(0)=DPI/2 ELSE DA(0)=ATN(H/SQR(1-H^2))
  174. 1570 DO(0)=DPI/2:HP=1:I=0
  175. 1580 DQ=DA(I):GOSUB 3380
  176. 1590 DV=2/(1+DQ1)-1
  177. 1600 DVW=DQ1
  178. 1610 DQ=DO(I):GOSUB 3380
  179. 1620 DW=DVW*DQ1
  180. 1630 IF DV=0 THEN DV=.0000001
  181. 1640 DA(I+1)=ATN(SQR(1-DV^2)/DV)
  182. 1650 IF SQR(1-DW^2)=0 THEN DO(I+1)=.5*(DO(I)+DPI/2):GOTO 1670
  183. 1660 DO(I+1)=.5*(DO(I)+ATN(DW/SQR(1-DW^2)))
  184. 1670 DZ=1-(DA(I+1)*2/DPI):I=I+1
  185. 1680 IF DZ>.0000001 THEN 1580
  186. 1690 FOR J=1 TO I
  187. 1700 DQ=DA(J)
  188. 1710 GOSUB 3510
  189. 1720 HP=HP*(1+DQ1)
  190. 1730 NEXT J
  191. 1740 DV=DPI/4+DO(I)/2
  192. 1750 DQ=DV:GOSUB 3380
  193. 1760 DSN=DQ1:DQ=DV:GOSUB 3510
  194. 1770 DCN=DQ1:IF DCN<0 THEN DCN=-1*DCN
  195. 1780 DTN=DSN/DCN
  196. 1790 H4=LOG(DTN)*HP
  197. 1800 RETURN
  198. 1810 REM ZERO LOCATIONS
  199. 1820 HU=(2*I-NN)*H4/N:GOSUB 1860
  200. 1830 Z(I)=HS:X(I)=HX/HS:F(I)=F1*X(I)
  201. 1840 RETURN
  202. 1850 REM SU(U,K)
  203. 1860 HQ=EXP(-DPI*H3/H4)
  204. 1870 HV=DPI/2*HU/H4:HS=0:J=0
  205. 1880 HW=HQ^(J+.5)
  206. 1890 Q=(2*J+1)*HV
  207. 1900 Q1=SIN(Q): IF Q1=0 THEN Q1=.0000001 
  208. 1910 HS=HS+HW*Q1/(1-HW^2):J=J+1
  209. 1920 IF HW>.0000001 THEN 1880
  210. 1930 HS=HS*2*DPI/H/H4
  211. 1940 RETURN
  212. 1950 REM POLE AND Q CALCULATION
  213. 1960 D1=10^(.1*A1)-1:DE=SQR(D1):DF=F1*F1
  214. 1970 M=NN+2*V:MM=2*INT(M/2):D2=2*DPI
  215. 1980 DK=0:RG=0:T=M
  216. 1990 IF V=0 THEN 2010
  217. 2000 FOR I=1 TO V:Z(I)=SQR(1-DF/F(I)/F(I)):NEXT I
  218. 2010 GOSUB 2110
  219. 2020 GOSUB 2260
  220. 2030 IF M>MM THEN DC(2*M)=0
  221. 2040 FOR I=0 TO 2*M STEP 2:DA(M-I/2)=DC(I)+D(I):NEXT I
  222. 2050 GOSUB 2420
  223. 2060 RG=RG+1:D=1+P(RG)+Q(RG):DB(RG)=(1+P(RG)/2)*DF/D
  224. 2070 P(RG)=F1/D^.25:Q(RG)=1/SQR(2*(1-DB(RG)/P(RG)^2))
  225. 2080 IF RG<MM/2 THEN 2060
  226. 2090 IF M>MM THEN F(RG+1)=SQR(DF/(A-1))
  227. 2100 RETURN
  228. 2110 FOR I=1 TO NN:DS(I)=1:NEXT I
  229. 2120 IF V=0 THEN 2150
  230. 2130 FOR I=NN+1 TO NN+V:DS(I)=Z(I-NN):NEXT I
  231. 2140 FOR I=NN+V+1 TO NN+2*V:DS(I)=Z(I-NN-V):NEXT I
  232. 2150 SS=I-1:GOSUB 2340
  233. 2160 FOR I=0 TO MM STEP 2:DA(I)=DE*DB(I):NEXT I
  234. 2170 FOR I=0 TO 2*MM STEP 2:GOSUB 2190:NEXT I
  235. 2180 RETURN
  236. 2190 IF I=>MM+2 THEN 2210
  237. 2200 J1=0:J2=I
  238. 2210 IF I<=MM THEN 2230
  239. 2220 J1=I-MM:J2=MM
  240. 2230 DC(I)=0
  241. 2240 FOR J=J1 TO J2 STEP 2:DC(I)=DC(I)+DA(J)*DA(I-J):NEXT J
  242. 2250 RETURN
  243. 2260 FOR I=1 TO NN:DS(I)=-1:NEXT I
  244. 2270 IF V=0 THEN 2300
  245. 2280 FOR I=NN+1 TO NN+V:DS(I)=-Z(I-NN)^2:NEXT I
  246. 2290 FOR I=NN+V+1 TO NN+2*V:DS(I)=DS(I-V):NEXT I
  247. 2300 SS=M:GOSUB 2340
  248. 2310 Z=INT(NN):NN=Z:DD=(-1)^Z
  249. 2320 FOR I=0 TO 2*M STEP 2:D(I)=DD*DB(I/2):NEXT I
  250. 2330 RETURN
  251. 2340 DB(0)=DS(1):DB(1)=1:J=1
  252. 2350 J=J+1
  253. 2360 DA(0)=DS(J)*DB(0)
  254. 2370 FOR I=1 TO J-1:DA(I)=DB(I-1)+DS(J)*DB(I):NEXT I
  255. 2380 FOR I=0 TO J-1:DB(I)=DA(I):NEXT I
  256. 2390 DB(J)=1
  257. 2400 IF J<SS THEN 2350
  258. 2410 RETURN
  259. 2420 FOR I=1 TO T:DA(I)=DA(I)/DA(0):NEXT I
  260. 2430 DA(0)=1:DB(0)=1:DC(0)=1:I1=0
  261. 2440 IF T=2 THEN 2570
  262. 2450 HP=0:DQ=0:I1=I1+1
  263. 2460 DB(1)=DA(1)-HP:DC(1)=DB(1)-HP
  264. 2470 FOR I=2 TO T:DB(I)=DA(I)-HP*DB(I-1)-DQ*DB(I-2):NEXT I
  265. 2480 FOR I=2 TO T-1:DC(I)=DB(I)-HP*DC(I-1)-DQ*DC(I-2):NEXT I
  266. 2490 X1=T-1:X2=T-2:X3=T-3:D4=DC(X2)^2+DC(X3)*(DB(X1)-DC(X1))
  267. 2500 IF D4=0 THEN D4=.001
  268. 2510 D1=(DB(X1)*DC(X2)-DB(T)*DC(X3))/D4:HP=HP+D1
  269. 2520 D2=(DB(T)*DC(X2)-DB(X1)*(DC(X1)-DB(X1)))/D4:DQ=DQ+D2
  270. 2530 IF ABS(D1)+ABS(D2)>.000001 THEN 2460
  271. 2540 P(I1)=HP:Q(I1)=DQ:DA(1)=DA(1)-HP:T=T-2
  272. 2550 FOR I=2 TO T:DA(I)=DA(I)-HP*DA(I-1)-DQ*DA(I-2):NEXT I
  273. 2560 IF T> 2 THEN 2450
  274. 2570 IF T<> 2 THEN 2590
  275. 2580 I1=I1 + 1:P(I1)=DA(1):Q(I1)=DA(2)
  276. 2590 IF T=1 THEN A=-DA(1)
  277. 2600 RETURN
  278. 2610 REM ELLIPTIC F & Q
  279. 2620 V=INT(N/2)
  280. 2630 IF N/2=INT(N/2) THEN NN=0 ELSE NN=1
  281. 2640 GOSUB 1960
  282. 2650 IF K$="Y" THEN GOSUB 3150
  283. 2660 IF R=1 AND K$="Y" THEN LPRINT:LPRINT "Required Resonant Frequencies are:"
  284. 2670 IF R=1 THEN PRINT:PRINT "Required Resonant Frequencies are:":GOTO 2700
  285. 2680 PRINT:PRINT "Normalized Prototype Parameters are:"
  286. 2690 IF K$="Y" THEN LPRINT:LPRINT "Normalized Prototype Parameters are:"
  287. 2700 PRINT :PRINT "     F         Q"
  288. 2710 IF K$="Y" THEN LPRINT:LPRINT "     F         Q"
  289. 2720 IF R=1 GOTO 2790
  290. 2730 FOR I=1 TO V:PRINT P(I),Q(I)
  291. 2740 IF K$="Y" THEN LPRINT P(I),Q(I)
  292. 2750 NEXT I
  293. 2760 IF INT(N/2)<>N/2 THEN PRINT F(V+1) ELSE GOTO 2860
  294. 2770 IF K$="Y" THEN LPRINT F(V+1)
  295. 2780 GOTO 2860
  296. 2790 OPEN "O",3,"PLTDATA"
  297. 2792 IF INT(N/2)<>N/2 THEN PRINT #3,1,3,2*V+1 ELSE PRINT #3,1,3,2*V
  298. 2798 FOR I=1 TO V:PRINT P(I)*FC,Q(I)
  299. 2800 IF K$="Y" THEN LPRINT P(I)*FC,Q(I)
  300. 2805 PRINT #3,P(I)*FC,Q(I)
  301. 2810 NEXT I
  302. 2820 IF INT(N/2)<>N/2 THEN PRINT F(V+1)*FC ELSE GOTO 2840
  303. 2830 IF K$="Y" THEN LPRINT F(V+1)*FC
  304. 2835 PRINT #3,F(V+1)*FC,0
  305. 2840 PRINT:PRINT "Required zeros (or Notches) are:"
  306. 2850 IF K$="Y" THEN LPRINT:LPRINT "Required zeros (or Notches) are:"
  307. 2860 PRINT "     Z"
  308. 2870 IF K$="Y" THEN LPRINT "     Z"
  309. 2880 IF R=1 GOTO 2930
  310. 2890 FOR I=1 TO V:PRINT F(I)
  311. 2900 IF K$="Y" THEN LPRINT F(I)
  312. 2910 NEXT I
  313. 2920 GOTO 2955
  314. 2930 FOR I=1 TO V:PRINT F(I)*FC
  315. 2940 IF K$="Y" THEN LPRINT F(I)*FC
  316. 2944 PRINT #3,F(I)*FC,-1
  317. 2950 NEXT I
  318. 2955 CLOSE 3
  319. 2960 OPEN "O",2,"IDATA"
  320. 2970 PRINT #2,F1,INT(N/2),INT(N/2)
  321. 2980 IF N/2<>INT(N/2) THEN PRINT #2,1,F(V+1) ELSE PRINT #2,0
  322. 2990 FOR I=1 TO V:PRINT #2,1,0,F(I):NEXT I
  323. 3000 FOR I=1 TO V:PRINT #2,P(I),Q(I):NEXT I
  324. 3010 CLOSE
  325. 3020 RETURN
  326. 3030 REM BUTTERWORTH
  327. 3040 PRINT #1,"     F           Q "
  328. 3050 FOR I=1 TO N/2:PRINT #1,F(I),Q(I):NEXT I
  329. 3060 IF INT(N/2)<>N/2 THEN PRINT #1,F(N/2+1)
  330. 3070 CLOSE 1
  331. 3080 RETURN
  332. 3090 REM CHEBYCHEV
  333. 3100 PRINT #1,"     F         Q"
  334. 3110 FOR I=1 TO N/2: PRINT #1,P(I),Q(I):NEXT I
  335. 3120 IF INT(N/2)<>N/2 THEN PRINT #1,F(INT(N/2)+1)
  336. 3130 CLOSE 1
  337. 3140 RETURN
  338. 3150 REM ELLIPTIC
  339. 3160 PRINT #1,"     F         Q"
  340. 3170 FOR I=1 TO V:PRINT #1,P(I),Q(I):NEXT I
  341. 3180 IF N/2<>V THEN PRINT #1,F(V+1)
  342. 3190 PRINT #1,"     Z"
  343. 3200 FOR I=1 TO V:PRINT #1,F(I):NEXT I
  344. 3210 CLOSE 1
  345. 3220 RETURN
  346. 3230 OPEN "O",#1,"LPT1"
  347. 3240 FOR I=0 TO 5:PRINT #1,V$(I),PR(I):NEXT I
  348. 3250 RETURN
  349. 3260 AA=1:N=2
  350. 3270 IF N=10 THEN PRINT "    ORDER TOO HIGH FOR PROGRAM!!!":GOTO 3360
  351. 3280 N=N+1:NN=0:HR=1
  352. 3290 IF N=2*INT(N/2) THEN NN=1
  353. 3300 FOR I=1 TO INT(N/2):GOSUB 1820:NEXT I
  354. 3310 FOR I=1 TO N/2:HR=HR*(1-Z(I)^2)/(1-X(I)^2):NEXT I
  355. 3320 HC=1/HR:X=HX:HR=HC*X^(1-NN)
  356. 3330 FOR I=1 TO N/2:HR=HR*(X^2-Z(I)^2)/(X^2-X(I)^2):NEXT I
  357. 3340 A=10*FN LGT(1+HE*HR^2)
  358. 3350 IF A<A2 THEN 3270
  359. 3360 RETURN
  360. 3370 REM SERIES EXPANSION OF SIN(X)
  361. 3380 DFACT=1:SN=-1:DQ1=DQ
  362. 3390 FOR K=3 TO 15 STEP 2
  363. 3400 DFACT1=K*(K-1)
  364. 3410 DFACT=DFACT*DFACT1
  365. 3420 DZ=1
  366. 3430 FOR Q=1 TO K
  367. 3440 DZ=DZ*DQ
  368. 3450 NEXT Q
  369. 3460 DQX1=(DZ/DFACT)*SN
  370. 3470 DQ1=DQ1+DQX1
  371. 3480 SN=-1*SN
  372. 3490 NEXT K
  373. 3500 RETURN
  374. 3510 REM SERIES EXPANSION OF COS(X)
  375. 3520 DFACT=1:SN=-1:DQ1=1
  376. 3530 FOR K=2 TO 14 STEP 2
  377. 3540 DFACT1=K*(K-1)
  378. 3550 DFACT=DFACT*DFACT1
  379. 3560 DZ=1
  380. 3570 FOR Q=1 TO K
  381. 3580 DZ=DZ*DQ
  382. 3590 NEXT Q
  383. 3600 DQX1=(DZ/DFACT)*SN
  384. 3610 DQ1=DQ1+DQX1
  385. 3620 SN=-1*SN
  386. 3630 NEXT K
  387. 3640 RETURN
  388. 3650 IF R=1 THEN R$="LOWPASS"
  389. 3660 IF R=2 THEN R$="HIGHPASS"
  390. 3670 IF R=3 THEN R$="BANDPASS"
  391. 3680 IF R=4 THEN R$="NOTCH"
  392. 3690 IF G=1 THEN T$="BUTTERWORTH"
  393. 3700 IF G=2 THEN T$="CHEBYSHEV"
  394. 3710 IF G=3 THEN T$="ELLIPTIC"
  395. 3720 IF R=1 AND K$="Y" THEN LPRINT:LPRINT "Design for a "T$" Lowpass with:"
  396. 3730 IF R=1 THEN PRINT:PRINT "Design for an "T$" Lowpass with:":GOTO 3920
  397. 3740 PRINT:PRINT "Lowpass Prototype for this "T$" "R$" filter with:"
  398. 3750 IF K$="Y" THEN LPRINT:LPRINT "Lowpass Prototype for this "T$" "R$" filter with:"
  399. 3760 IF R=2 GOTO 3920
  400. 3770 PRINT:PRINT "Fcenter="FCNTR"  Pass Bandwidth="BW"  Stop Bandwidth="SW
  401. 3780 IF K$="Y" THEN LPRINT:LPRINT "Fcenter="FCNTR"  Pass Bandwidth="BW"  Stop Bandwidth="SW
  402. 3790 IF K$="Y" AND Z$="Y" THEN LPRINT:LPRINT "Amax="A1"  Order="N
  403. 3800 IF Z$="Y" THEN PRINT:PRINT "Amax="A1"  Order="N:GOTO 3830
  404. 3810 IF K$="Y" THEN LPRINT:LPRINT "Amax="A1"  Amin="A2
  405. 3820 PRINT:PRINT "Amax="A1"  Amin="A2
  406. 3830 PRINT:PRINT "Normalized Parameters are:"
  407. 3840 IF K$="Y" THEN LPRINT:LPRINT "Normalized Parameters are:"
  408. 3850 PRINT:PRINT "FC="F1"   FS="F2"   Amax="A1"   ";
  409. 3860 IF K$="Y" THEN LPRINT:LPRINT "FC="F1"  FS="F2"  Amax="A1"   ";
  410. 3870 IF K$="Y" AND Z$="Y" THEN LPRINT "N="N/2
  411. 3880 IF Z$="Y" THEN PRINT "N="N/2:N=N/2:GOTO 3910
  412. 3890 IF K$="Y" THEN LPRINT "Amin="A2
  413. 3900 PRINT "Amin="A2
  414. 3910 RETURN
  415. 3920 PRINT:PRINT "Corner Frequency="FC"  Stop Frequency="FS"    ";
  416. 3930 IF K$="Y" THEN LPRINT:LPRINT "Corner Frequency="FC"  Stop Frequency="FS"    ";
  417. 3940 IF K$="Y" AND Z$="Y" THEN LPRINT "Order="N"   Amax="A1
  418. 3950 IF Z$="Y" THEN PRINT "Order="N"   Amax="A1:GOTO 3980
  419. 3960 IF K$="Y" THEN LPRINT "Amax="A1"   Amin="A2
  420. 3970 PRINT "Amax="A1"   Amin="A2
  421. 3980 PRINT:PRINT "Normalized Parameters are:"
  422. 3990 IF K$="Y" THEN LPRINT:LPRINT "Normalized Parameters are:"
  423. 4000 PRINT:PRINT "FC="F1"  FS="F2"   Amax="A1"   ";
  424. 4010 IF K$="Y" THEN LPRINT:LPRINT "FC="F1"  FS="F2"   Amax="A1"   ";
  425. 4020 IF K$="Y" AND Z$="Y" THEN LPRINT "N="N
  426. 4030 IF Z$="Y" THEN PRINT "N="N:GOTO 4060
  427. 4040 PRINT "Amin="A2
  428. 4050 IF K$="Y" THEN LPRINT "Amin="A2
  429. 4060 RETURN
  430.