home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / tech / eepup2 / nrbnpas.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1979-12-31  |  9.4 KB  |  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))<9.9999E-05 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))<9.9999E-05 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>=0.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))<=9.9999E-05 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)>0.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))<9.9999E-05 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.343*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.343*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.686*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+0.85*N/I*A)
  290. 2890  PRINT 0.1*INT(10*(I-LR)+0.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.