home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / tech / design1 / nrbnpas.bas < prev    next >
BASIC Source File  |  1987-02-07  |  11KB  |  312 lines
  1. 10 REM * NARROW BAND PASS FILTER DESIGN
  2. 20 REM * W.E.SABIN, 1982
  3. 30 REM *********************************
  4. 40 REM * USE K,Q VALUES (3 DB DOWN)    *
  5. 50 REM * FOR THE LOWPASS PROTOTYPE.    *
  6. 60 REM * RELATIVE BANDWIDTH=BW(3 DB)   *
  7. 70 REM * /FO. ADJUST BW(3DB) TO GET    *
  8. 80 REM * DESIRED PASSBAND.             *
  9. 90 REM * BW(BP)=BW(LP)                 *
  10. 100 REM* COUPLING IS SERIES/SHUNT      *
  11. 110 REM* C OR L. USE CAP               *
  12. 120 REM* DIVIDER, IND. DIVIDER, OR     *
  13. 130 REM* TOP L OR C FOR Z MATCH        *
  14. 140 REM* AT INPUT AND OUTPUT.          *
  15. 150 REM* SELECT FILTER INTERNAL Z      *
  16. 160 REM* AND COIL UNLOADED Q.          *
  17. 170 REM* MAX N=10. RESONATOR 1 IS      *
  18. 180 REM* ALWAYS LOADED WITH R.         *
  19. 190 REM*********************************
  20. 200 PI=4*ATN(1)
  21. 210 CLS
  22. 220 PRINT"DESIGN DISHAL NARROWBANDPASS FILTER"
  23. 230 PRINT:PRINT "2 TO 10 RESONATORS."
  24. 240 PRINT:INPUT "NUMBER OF RESONATORS=";N
  25. 250 INPUT"CENTER FREQUENCY=";FO
  26. 260 OM=2*PI*FO
  27. 270 INPUT"3 DB BANDWIDTH=";BW
  28. 280 PRINT"ENTER 'INF' FOR INFINITE VALUE"
  29. 290 INPUT "UNLOADED COIL Q=";QU$
  30. 300 IF QU$="INF" THEN QU=100000!:GOTO 320
  31. 310 QU=VAL(QU$)
  32. 320 W=BW/FO:QP=QU*W
  33. 330 PRINT"NORMALIZED QP OF LOW PASS PROTOTYPE =";QP
  34. 340 PRINT "BASED ON QP, DETERMINE THE LOWPASS PROTOTYPE 3 DB DOWN K,Q VALUES FROM SOME REFERENCE SOURCE"
  35. 350 PRINT:PRINT"IS QP LARGE ENOUGH (Y/N) ?"
  36. 360 A$=INKEY$:IF A$="" THEN 360
  37. 370 PRINT:PRINT "ENTER 'INF' FOR INFINITE Q"
  38. 380 PRINT"INPUT TERMINAL IS RESISTANCE LOADED"
  39. 390 INPUT"Q(1)=";Q(1)
  40. 400 PRINT"Q(";N;")=";:INPUT Q$
  41. 410 IF Q$="INF" THEN Q(N)=100000!:R2=1E+08: GOTO 430
  42. 420 Q(N)=VAL(Q$)
  43. 430 PRINT
  44. 440 FOR I=1 TO N-1
  45. 450 PRINT"K(";I;",";I+1;")=";
  46. 460 INPUT K(I)
  47. 470 NEXT:PRINT
  48. 480 PRINT"LOADED, DENORMALIZED Q:"
  49. 490 Q(1)=Q(1)/W:PRINT "Q(1)=";Q(1),
  50. 500 IF Q(N)=100000! THEN PRINT "Q(";N;")= INF":GOTO 520
  51. 510 Q(N)=Q(N)/W:PRINT "Q(";N;")=";Q(N)
  52. 520 IF QU < 1.25*Q(1) THEN PRINT:PRINT "COIL Q MUST BE AT LEAST ";1.25*Q(1);". INCREASE COIL Q OR START OVER.": GOTO 290
  53. 530 PRINT: PRINT "INPUT RESONATOR SPECIFICATION MENU:"
  54. 540 INPUT "SPECIFY 'L', 'C', 'R' :";A$
  55. 550 IF A$="R" THEN INPUT "R=";RF:C=Q(1)/(OM*RF):L=RF/(OM*Q(1))
  56. 560 IF A$="L" THEN INPUT "L=";L: C=1/(OM ^2*L):RF=OM*L*Q(1)
  57. 570 IF A$="C" THEN INPUT "C=";C:L=1/(OM^2*C): RF=OM*L*Q(1)
  58. 580 PRINT: PRINT "L=";L:PRINT "C=";C: PRINT "R=";RF
  59. 590 PRINT
  60. 600 PRINT "ARE L, C, R SATISFACTORY (Y/N) ?"
  61. 610 A$=INKEY$:IF A$="" THEN 610
  62. 620 IF A$="N" THEN GOTO 530
  63. 630 PRINT "ARE THE UNLOADED COIL Q AND THE 3 DB BANDWIDTH STILL SATISFACTORY ? (Y/N)"
  64. 640 A$=INKEY$:IF A$="" THEN 640
  65. 650 IF A$="N" THEN GOTO 250
  66. 660 RL=OM*L*QU: PRINT "COIL RESISTANCE=";RL: PRINT
  67. 670 RR(1)=1/(1/(OM*L*Q(1))-1/(OM*L*QU)): PRINT "REQUIRED SOURCE RESISTANCE =";RR(1)
  68. 680 IF Q(N)>= QP/W THEN PRINT "REQUIRED LOAD RESISTANCE = INF": RR(N)=1E+08: GOTO 700
  69. 690 RR(N)=1/(1/(OM*L*Q(N))-1/(OM*L*QU)):PRINT "REQUIRED LOAD RESISTANCE=";RR(N)
  70. 700 PRINT:FOR I=1 TO N
  71. 710 IF I=N THEN GOTO 750
  72. 720 K(I)=K(I)*W
  73. 730 CT(I)=K(I)*C
  74. 740 PRINT "CT(";I;")=";CT(I)
  75. 750 IF I=1 THEN C(1)=C-CT(1):PRINT "C(1)=";C(1): GOTO 780
  76. 760 IF I=N THEN C(N)=C-CT(N-1): PRINT "C(";N;")=";C(N):GOTO 780
  77. 770 C(I)=C-CT(I-1)-CT(I):PRINT "C(";I;")=";C(I)
  78. 780 L(I)=L
  79. 790 NEXT I:PRINT
  80. 800 INPUT "WIRING + AVERAGE TRIMMER C FOR EACH RESONATOR=";CS
  81. 810 PRINT: FOR I=1 TO N
  82. 820 C(I)=C(I)-CS:PRINT "C(";I;")=";C(I)
  83. 830 NEXT:PRINT
  84. 840 PRINT:PRINT "TYPE 'SPACE' TO GO ON":PRINT
  85. 850 A$=INKEY$:IF A$="" THEN 850
  86. 860 PRINT "COUPLING MODIFICATIONS MENU":PRINT
  87. 870 PRINT "TYPE 1 FOR CAPACITOR PI TO TEE"
  88. 880 PRINT "TYPE 2 FOR L COUPLED C"
  89. 890 PRINT "TYPE 3 FOR INDUCTOR TEE"
  90. 900 PRINT "TYPE 4 FOR C COUPLED L"
  91. 910 PRINT "TYPE 5 FOR M COUPLING"
  92. 920 PRINT "TYPE 6 TO CONTINUE"
  93. 930 INPUT X: PRINT
  94. 940 ON X GOTO 1160, 1240, 1330, 1430, 1520, 950
  95. 950 REM ***** DESIGN I/O TRANSFORMERS *****
  96. 960 CLS:PRINT
  97. 970 PRINT "DESIGN I/O IMPEDANCE TRANSFORMERS"
  98. 980 PRINT:PRINT "SELECT TYPE OF TRANSFORMER AT INPUT:":PRINT
  99. 990 U=1
  100. 1000 PRINT
  101. 1010 PRINT "TYPE 1 FOR C DIVIDER"
  102. 1020 PRINT "TYPE 2 FOR L DIVIDER"
  103. 1030 PRINT "TYPE 3 FOR LINK COUPLING"
  104. 1040 PRINT "TYPE 4 FOR TOP C"
  105. 1050 PRINT "TYPE 5 FOR TOP L"
  106. 1060 PRINT "TYPE 6 TO CONTINUE"
  107. 1070 INPUT T:PRINT
  108. 1080 IF T =6 THEN GOTO 1120
  109. 1090 IF U=1 THEN INPUT "SOURCE RESISTANCE=";R
  110. 1100 IF U=N THEN INPUT "LOAD RESISTANCE=";R
  111. 1110 ON T GOSUB 1580,1700,1830,2020,2100,1120
  112. 1120 IF U=N THEN GOTO 2410
  113. 1130 IF Q(N)>=QP/W THEN PRINT "OUTPUT PORT IS OPEN CIRCUIT":GOTO 2410
  114. 1140 PRINT:PRINT "SELECT TYPE OF TRANSFORMER AT OUTPUT:": PRINT:U=N
  115. 1150 GOTO 1000
  116. 1160 REM ***** CHANGE CAP PI TO CAP TEE *****
  117. 1170 PRINT: INPUT "FIRST NODE=";A
  118. 1180 PRINT "SECOND NODE=";A+1
  119. 1190 CD=C(A)*C(A+1)+C(A+1)*CT(A)+C(A)*CT(A)
  120. 1200 CA=CD/C(A+1):PRINT "C(";A;")=";CA
  121. 1210 CB=CD/C(A):PRINT "C(";A+1;")=";CB
  122. 1220 CC=CD/CT(A):PRINT "BOTTOM COUPLING C=";CC
  123. 1230 PRINT:GOTO 860
  124. 1240 REM ***** CHANGE TOP C TO L COUPLED C *****
  125. 1250 PRINT:INPUT "FIRST NODE=";A
  126. 1260 PRINT "SECOND NODE=";A+1
  127. 1270 C(A)=C(A)+CT(A):PRINT "C(";A;")=";C(A)
  128. 1280 C(A+1)=C(A+1)+CT(A):PRINT "C(";A+1;")=";C(A+1)
  129. 1290 M=CT(A)*SQR(L(A)*L(A+1))/SQR(C(A)*C(A+1)):PRINT "M=";M
  130. 1300 L(A)=L(A)-M:PRINT "L(";A;")=";L(A)
  131. 1310 L(A+1)=L(A+1)-M:PRINT "L(";A+1;")=";L(A+1)
  132. 1320 PRINT:GOTO 860
  133. 1330 REM ***** CHANGE TOP C TO INDUCTOR TEE *****
  134. 1340 INPUT "FIRST NODE=";A
  135. 1350 PRINT "SECOND NODE=";A+1
  136. 1360 C(A)=C(A)+CT(A):PRINT "C(";A;")=";C(A)
  137. 1370 C(A+1)=C(A+1)+CT(A):PRINT "C(";A+1;")=";C(A+1)
  138. 1380 M=K(A)*SQR(L(A)*L(A+1)):PRINT "MUTUAL INDUCTANCE=";M
  139. 1390 IF X=5 THEN RETURN
  140. 1400 L(A)=L(A)-M:PRINT "L(";A;")=";L(A)
  141. 1410 L(A+1)=L(A+1)-M: PRINT "L(";A+1;")=";L(A+1)
  142. 1420 PRINT: GOTO 860
  143. 1430 REM ***** CHANGE TOP C TO C COUPLED L *****
  144. 1440 INPUT "FIRST NODE=";A
  145. 1450 PRINT "SECOND NODE=";A+1
  146. 1460 C(A)=C(A)+CT(A):PRINT "C(";A;")=";C(A)
  147. 1470 C(A+1)=C(A+1)+CT(A): PRINT "C(";A+1;")=";C(A+1)
  148. 1480 M=K(A)*SQR(L(A)*L(A+1)):CM=1/(OM^2*M):PRINT "CM=";CM
  149. 1490 L(A)=L(A)+M:PRINT "L(";A;")=";L(A)
  150. 1500 L(A+1)=L(A+1)+M:PRINT "L(";A+1;")=";L(A+1)
  151. 1510 PRINT: GOTO 860
  152. 1520 REM ***** CHANGE TOP C TO M *****
  153. 1530 GOSUB 1340
  154. 1540 PRINT "COEFF OF COUPLING=";K(A)
  155. 1550 PRINT "L(";A;")=";L(A)
  156. 1560 PRINT "L(";A+1;")=";L(A+1)
  157. 1570 PRINT: GOTO 860
  158. 1580 REM ***** CAPACITIVE DIVIDER *****
  159. 1590 CX=C(U)*SQR(RR(U)/R)/SQR(RR(U)/R-1)
  160. 1600 K=C(U)*RR(U)
  161. 1610 CC=CX^2/4-(1-OM^2*R*CX*K)/(OM*R)^2
  162. 1620 IF CC<=0 THEN PRINT "CANNOT MATCH":GOTO 1000
  163. 1630 CY=-CX/2+SQR(CC)
  164. 1640 RI=(1+OM^2*R^2*(CY+CX)^2)/(OM^2*R*CX^2)
  165. 1650 IF ABS((RR(U)-RI)/RR(U))<.0001 THEN GOTO 1670
  166. 1660 CX=CX*RI/RR(U):GOTO 1610
  167. 1670 PRINT:PRINT "C(";U;")=";CX
  168. 1680 PRINT "BOTTOM CAP=";CY
  169. 1690 PRINT:RETURN
  170. 1700 REM ***** INDUCTIVE DIVIDER *****
  171. 1710 LY=L(U)*SQR(R/RR(U))
  172. 1720 K=RR(U)/L(U)
  173. 1730 LX=R*LY*(LY*K-R)/((OM*LY)^2+R^2)
  174. 1740 IF LX=LL THEN PRINT "NO MATCH":GOTO 1000
  175. 1750 RI=((OM*LX*LY)^2+R^2*(LX+LY)^2)/(R*LY^2)
  176. 1760 IF ABS ((RR(U)-RI)/RR(U))<.0001 THEN GOTO 1790
  177. 1770 LY=LY*SQR(RR(U)/RI)
  178. 1780 LL=LX:GOTO 1730
  179. 1790 PRINT:PRINT "BOTTOM COIL=";LY
  180. 1800 L(U)=LX
  181. 1810 PRINT "VALUE OF TOP COIL L(";U;")=";L(U)
  182. 1820 PRINT:RETURN
  183. 1830 REM ***** LINK COUPLING *****
  184. 1840 INPUT "ESTIMATE OF COUPLING COEFFICIENT=";KK
  185. 1850 XX=0
  186. 1860 LY=L(U)*R/RR(U)/KK^2
  187. 1870 LX=L(U)*((OM*LY)^2*(1-KK^2)+R^2)/((OM*LY)^2*(1-KK^2)^2+R^2)
  188. 1880 RI=R*LX/KK^2/LY+OM^2*LX*LY/R*(1-KK^2)^2/KK^2
  189. 1890 RM=2*OM*LX*(1-KK^2)/KK^2
  190. 1900 IF RM>=.8*RR(U) THEN PRINT "THE VALUE OF COUPLING COEFFICIENT, ";KK;" IS TOO SMALL":GOTO 1840
  191. 1910 IF ABS ((RR(U)-RI)/RR(U))<=.0001 THEN GOTO 1930
  192. 1920 LY=LY*RI/RR(U):GOTO 1870
  193. 1930 PRINT:PRINT "LX=";LX
  194. 1940 PRINT"LY=";LY
  195. 1950 PRINT:IF XX=0 THEN GOSUB 3070
  196. 1960 RZ=OM*LY/QL
  197. 1970 IF XX=0 THEN R=R+RZ:XX=1:GOTO 1860
  198. 1980 PRINT "TYPE 'Y' TO RECALCULATE USING NEW VALUE OF COUPLING COEFFICIENT"
  199. 1990 A$=INKEY$:IF A$="" THEN 1990
  200. 2000 IF A$="Y" THEN GOTO 1840
  201. 2010 RETURN
  202. 2020 REM ***** TOP C COUPLING TRANSFORMER *****
  203. 2030 CX=1/OM/SQR(R*(RR(U)-R))
  204. 2040 CO=CX/(1+(OM*CX*R)^2)
  205. 2050 C(U)=C(U)-CO
  206. 2060 PRINT:PRINT "TOP COUPLING C=";CX
  207. 2070 PRINT "NEW C(";U;")=";C(U)
  208. 2080 IF C(U)=<0 THEN PRINT "NO MATCH": C(U)=C(U)+CO:GOTO 1000
  209. 2090 RETURN
  210. 2100 REM ***** TOP L COUPLING TRANSFORMER *****
  211. 2110 Z=0:LX=1/OM*SQR(R*(OM*L*Q(U)-R))
  212. 2120 PRINT "APPROX. VALUE OF LX=";LX
  213. 2130 INPUT "APPROX. Q OF LX=";QX$
  214. 2140 IF QX$="INF" THEN QX=100000!:GOTO 2160
  215. 2150 QX=VAL(QX$)
  216. 2160 RI=((R+OM*LX/QX)^2+(OM*LX)^2)/(R+OM*LX/QX)
  217. 2170 LO=RI*(R+OM*LX/QX)/(OM^2*LX)
  218. 2180 L(U)=1/(1/L-1/LO)
  219. 2190 IF Z=1 THEN GOTO 2260
  220. 2200 PRINT "APPROX. VALUE OF L(";U;")=";L(U)
  221. 2210 IF L(U)=<0 THEN PRINT "NO MATCH": GOTO 1000
  222. 2220 PRINT "Q OF L(";U;")=";
  223. 2230 INPUT QL$
  224. 2240 IF QL$="INF" THEN QL=100000!:GOTO 2260
  225. 2250 QL=VAL(QL$)
  226. 2260 RY=QL*OM*L(U)
  227. 2270 IF L*Q(U)>.8*L(U)*QL THEN PRINT "Q CHOSEN TOO SMALL": GOTO 2100
  228. 2280 QI=1/(OM*L)/(1/RY+1/RI)
  229. 2290 IF ABS((Q(U)-QI)/Q(U))<.0001 THEN GOTO 2320
  230. 2300 LX=LX*SQR(Q(U)/QI)
  231. 2310 Z=1: GOTO 2160
  232. 2320 PRINT:PRINT"LX=";LX
  233. 2330 PRINT"L(";U;")=";L(U)
  234. 2340 PRINT "Q OF L(";U;")=";QL
  235. 2350 PRINT "TOTAL Q=";QI
  236. 2360 PRINT "LOAD RESISTANCE=";RI
  237. 2370 PRINT "DO YOU WANT TO REPEAT (Y/N)?"
  238. 2380 A$=INKEY$:IF A$="" THEN 2380
  239. 2390 IF A$="Y" THEN PRINT:GOTO 2110
  240. 2400 RETURN
  241. 2410 REM ***** INSERTION LOSS *****
  242. 2420 PRINT "TYPE 'SPACE' TO GO ON "
  243. 2430 A$=INKEY$:IF A$="" THEN 2430
  244. 2440 CLS:PRINT "FIND INSERTION LOSS"
  245. 2450 PRINT "FOR PSEUDO-EXACT, INPUT '1'"
  246. 2460 INPUT "FOR OTHERS, INPUT '0'";P
  247. 2470 PRINT "PROTOTYPE Q=";QP
  248. 2480 Q(1)=Q(1)*W:Q(N)=Q(N)*W
  249. 2490 X(1)=Q(1)
  250. 2500 RS=1/(1-X(1)/QP)
  251. 2510 IF 2*INT(N/2)=N THEN RS=1/RS
  252. 2520 IF P=1 THEN RS=1
  253. 2530 PRINT "PROTOTYPE RS=";RS
  254. 2540 FOR I=1 TO N-1
  255. 2550 K(I)=K(I)/W
  256. 2560 X(I+1)=1/(K(I)^2*X(I))
  257. 2570 NEXT
  258. 2580 S=0
  259. 2590 FOR I=1 TO N
  260. 2600 S=S+X(I)
  261. 2610 NEXT
  262. 2620 LR=4.343001*S/QP
  263. 2630 PRINT "RESISTIVE LOSS (DB)=";LR
  264. 2640 IF Q(N)=>QP THEN PRINT "MISMATCH LOSS NOT DEFINED":GOTO 2720
  265. 2650 R2=1/(X(N)/Q(N)-X(N)/QP)
  266. 2660 IF P=1 THEN R2=Q(N)/X(N)
  267. 2670 LM=4.343001*LOG((RS+R2)^2/(4*R2*RS))
  268. 2680 PRINT "PROTOTYPE RL=";R2;" OHMS"
  269. 2690 PRINT "MISMATCH LOSS (DB)=";LM
  270. 2700 LT=LR+LM
  271. 2710 PRINT "INSERTION LOSS (DB)=";LT
  272. 2720 REM ***** PROTOTYPE VALUES *****
  273. 2730 PRINT: PRINT "LOWPASS PROTOTYPE VALUES"
  274. 2740 A=-1*(-1)^N
  275. 2750 FOR I=1 TO N
  276. 2760 PRINT "X(";I;")=";X(I),
  277. 2770 IF A=1 THEN PRINT "R(";I;")=";QP/X(I)
  278. 2780 IF A=-1 THEN PRINT "R(";I;")=";X(I)/QP
  279. 2790 A=-A
  280. 2800 NEXT
  281. 2810 REM ***** STOPBAND RESPONSE *****
  282. 2820 A$=INKEY$:IF A$="" THEN 2820
  283. 2825 PRINT:PRINT "APPROXIMATE STOPBAND RESPONSE"
  284. 2830 INPUT "ENTER 1 FOR CHEBY, MIN-LOSS, 0 FOR OTHERS ";A
  285. 2840 X=1: FOR I=1 TO N: X=X*X(I):NEXT
  286. 2850 FOR I=20 TO 60 STEP 10
  287. 2860 U=I/(8.686001*N)-LOG(2*PI)-1/N*LOG(X)+1/N*LOG((RS+R2)/R2)
  288. 2870 F=EXP(U)
  289. 2880 BY=BW*2*PI*F*(1+.8499999*N/I*A)
  290. 2890 PRINT .1*INT(10*(I-LR)+.5);" DB BW=";INT(BY);" HZ"
  291. 2900 NEXT
  292. 2910 REM ***** UNLOADED OUTPUT RESISTANCE AT FO *****
  293. 2920 IF Q(N)<QP THEN GOTO 3060
  294. 2930 G(1)=1
  295. 2940 FOR I=2 TO N
  296. 2950 G(I)=(Q(1)*K(I-1))^2/G(I-1)+RF/RL
  297. 2960 NEXT
  298. 2970 RO=INT(RF/G(N))
  299. 2980 PRINT:PRINT "UNLOADED OUTPUT RESISTANCE AT F0=";RO
  300. 2990 INPUT "DESIRED OUTPUT RESISTANCE=";RP
  301. 3000 IF RO=RP THEN GOTO 3060
  302. 3010 PRINT "C DIVIDER, C1 BOTTOM, C2 TOP"
  303. 3020 C1=C(N)*SQR(RO/RP)
  304. 3030 PRINT "C1=";C1
  305. 3040 C2=C(N)*SQR(RO/RP)/(SQR(RO/RP)-1)
  306. 3050 PRINT "C2=";C2
  307. 3060 PRINT:PRINT "COMPLETE":END
  308. 3070 REM ***** LINK COIL SUBROUTINE *****
  309. 3080 INPUT "Q OF LINK COIL=";QL$
  310. 3090 IF QL$="INF" THEN QL=100000!:RETURN
  311. 3100 QL=VAL(QL$):RETURN
  312.