home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1
/
HamRadio.cdr
/
tech
/
eepub10
/
nrbnpas.asc
< prev
next >
Wrap
Text File
|
1986-10-15
|
13KB
|
317 lines
100 REM "NRBNPAS"
110 REM W.SABIN -1982; REVISED V.HEESEN -1986
120 KEY OFF :CLS :PI=4*ATN(1)
130 PRINT TAB(20);"**** DISHAL NARROW BANDPASS FILTERS ****"
140 PRINT :PRINT "THIS PROGRAM DESIGNS BANDPASS FILTERS OF 2 TO 10 RESONATORS."
150 REM *********************************
160 REM * USE K,Q VALUES (3 DB DOWN) *
170 REM * FOR THE LOWPASS PROTOTYPE. *
180 REM * RELATIVE BANDWIDTH=BW(3 DB) *
190 REM * /FO. ADJUST BW(3DB) TO GET *
200 REM * DESIRED PASSBAND. *
210 REM * BW(BP)=BW(LP) *
220 REM* COUPLING IS SERIES/SHUNT *
230 REM* C OR L. USE CAP *
240 REM* DIVIDER, IND. DIVIDER, OR *
250 REM* TOP L OR C FOR Z MATCH *
260 REM* AT INPUT AND OUTPUT. *
270 REM* SELECT FILTER INTERNAL Z *
280 REM* AND COIL UNLOADED Q. *
290 REM* MAX N=10. RESONATOR 1 IS *
300 REM* ALWAYS LOADED WITH R. *
310 REM*********************************
320 PRINT :BEEP :INPUT "NUMBER OF RESONATORS = ";N :IF N<2 OR N>10 THEN 140
330 PRINT :BEEP :INPUT"CENTER FREQUENCY (MHz)=";FO :FO=FO*10^6
340 OM=2*PI*FO
350 PRINT :BEEP :INPUT"3 DB BANDWIDTH (MHz)=";BW :BW=BW*10^6
360 PRINT :PRINT"IF A VALUE IS INFINITE ENTER INF"
370 PRINT :BEEP :INPUT "UNLOADED COIL Q =";QU$
380 IF QU$="INF" THEN QU=100000! :GOTO 400
390 QU=VAL(QU$)
400 W=BW/FO :QP=QU*W
410 PRINT :PRINT "NORMALIZED QP OF LOW PASS PROTOTYPE =";QP :PRINT
420 PRINT "BASED ON QP, DETERMINE THE LOWPASS PROTOTYPE (3 DB DOWN) K,Q VALUES";
430 PRINT "FROM REFERENCE TABLES."
440 PRINT :BEEP :PRINT"IS QP LARGE ENOUGH (Y/N) ?"
450 A$=INKEY$ :IF A$="" THEN 450 ELSE IF A$="N" THEN 290
460 PRINT"INPUT TERMINAL IS RESISTANCE LOADED."
470 PRINT :PRINT "NOTE: IF Q INFINITE ENTER INF"
480 BEEP :INPUT"Q(1) = ";Q(1)
490 BEEP :PRINT"Q(";N;")="; :INPUT Q$
500 IF Q$="INF" THEN Q(N)=100000! :R2=1E+08 :GOTO 520
510 Q(N)=VAL(Q$)
520 PRINT
530 FOR I=1 TO N-1
540 BEEP :PRINT"K(";I;",";I+1;")=";
550 INPUT K(I)
560 NEXT I :PRINT
570 PRINT"LOADED, DENORMALIZED Q:"
580 Q(1)=Q(1)/W :PRINT "Q(1)=";Q(1),
590 IF Q(N)=100000! THEN PRINT "Q(";N;")= INF" :GOTO 610
600 Q(N)=Q(N)/W :PRINT "Q(";N;")=";INT(Q(N)*1000)/1000 :GOTO 640
610 IF QU >1.25*Q(1) THEN 640
620 PRINT:PRINT "COIL Q MUST BE AT LEAST "; 1.25*Q(1)
630 PRINT :PRINT "INCREASE COIL Q OR START OVER." :GOTO 370
640 PRINT :PRINT "*** INPUT RESONATOR SPECIFICATION MENU ***"
650 BEEP :INPUT "SPECIFY: L, C or R ";A$
660 IF A$<>"R" THEN 680
670 BEEP :INPUT "R (ohms)=";RF :C=Q(1)/(OM*RF) :L=RF/(OM*Q(1)) :GOTO 720
680 IF A$<>"L" THEN 700
690 BEEP :INPUT "L (uh) =";L :L=L*10^-6 :C=1/(OM ^2*L) :RF=OM*L*Q(1) :GOTO 720
700 IF A$<>"C" THEN 650
710 BEEP :INPUT "C (pf) =";C :C=C*10^-12 :L=1/(OM^2*C) :RF=OM*L*Q(1)
720 PRINT "L =";INT(L*10^6*1000)/1000;"uh"
730 PRINT "C =";INT(C*10^12*1000)/1000;"pf"
740 PRINT "R =";INT(RF*1000)/1000;"ohms"
750 PRINT :BEEP :PRINT "ARE L, C, and R SATISFACTORY (Y/N) ?"
760 A$=INKEY$ :IF A$="" THEN 760
770 IF A$="N" THEN 640
780 BEEP :PRINT "ARE UNLOADED COIL Q AND BW3 DB STILL SATISFACTORY ? (Y/N)"
790 A$=INKEY$ :IF A$="" THEN 790
800 IF A$="N" THEN 330
810 RL=OM*L*QU:PRINT:PRINT "COIL RESISTANCE=";INT(RL*100)/100;"ohms":PRINT
820 RR(1)=1/(1/(OM*L*Q(1))-1/(OM*L*QU)): PRINT "REQUIRED SOURCE RESISTANCE =";INT(RR(1)*100)/100;"ohms"
830 IF Q(N)>= QP/W THEN PRINT "REQUIRED LOAD RESISTANCE = INF": RR(N)=1E+08: GOTO 850
840 RR(N)=1/(1/(OM*L*Q(N))-1/(OM*L*QU)):PRINT "REQUIRED LOAD RESISTANCE=";RR(N)
850 PRINT:FOR I=1 TO N
860 IF I=N THEN 890
870 K(I)=K(I)*W
880 CT(I)=K(I)*C :PRINT "CT(";I;")=";INT(CT(I)*10^12*1000)/1000;"pf"
890 IF I=1 THEN 900 ELSE 910
900 C(1)=C-CT(1):PRINT "C(1)=";INT(C(1)*10^12*1000)/1000;"pf" :GOTO 940
910 IF I=N THEN 920 ELSE 930
920 C(N)=C-CT(N-1):PRINT "C(";N;")=";INT(C(N)*10^12*1000)/1000;"pf" :GOTO 940
930 C(I)=C-CT(I-1)-CT(I):PRINT "C(";I;")=";INT(C(I)*10^12*1000)/1000;"pf"
940 L(I)=L
950 NEXT I :PRINT
960 BEEP :INPUT "WIRING + AVERAGE TRIMMER C FOR EACH RESONATOR (pf) =";CS
970 CS=CS*10^-12
980 PRINT :FOR I=1 TO N
990 C(I)=C(I)-CS :PRINT "C(";I;")=";INT(C(I)*10^12*1000)/1000;"pf"
1000 NEXT :PRINT
1010 BEEP :PRINT "PRESS <SPACE> TO CONTINUE" :PRINT
1020 A$=INKEY$:IF A$="" THEN 1020
1030 PRINT "*** COUPLING MODIFICATIONS MENU ***":PRINT
1040 PRINT "ENTER: 1 for CAPACITOR PI to TEE"
1050 PRINT " 2 for L COUPLED C"
1060 PRINT " 3 for INDUCTOR TEE"
1070 PRINT " 4 for C COUPLED L"
1080 PRINT " 5 for M COUPLING"
1090 PRINT " 6 to CONTINUE"
1100 BEEP :INPUT X :PRINT
1110 ON X GOTO 1300,1380,1470,1570,1670,1120
1120 CLS :PRINT "*** DESIGN I/O IMPEDANCE TRANSFORMERS ***" :PRINT
1130 BEEP :PRINT "SELECT TYPE OF INPUT TRANSFORMER: ":PRINT :U=1
1140 PRINT
1150 PRINT "ENTER: 1 for C DIVIDER"
1160 PRINT " 2 for L DIVIDER"
1170 PRINT " 3 for LINK COUPLING"
1180 PRINT " 4 for TOP C"
1190 PRINT " 5 for TOP L"
1200 PRINT " 6 to CONTINUE"
1210 INPUT T :PRINT
1220 IF T=6 THEN 1260
1230 IF U=1 THEN BEEP :INPUT "SOURCE RESISTANCE =";R
1240 IF U=N THEN BEEP :INPUT "LOAD RESISTANCE =";R
1250 ON T GOSUB 1730,1850,1980,2180,2260,1260
1260 IF U=N THEN 2590
1270 IF Q(N)>=QP/W THEN PRINT "OUTPUT PORT IS OPEN CIRCUIT" :GOTO 2590
1280 PRINT :BEEP :PRINT "SELECT TYPE OF TRANSFORMER AT OUTPUT:" :PRINT :U=N
1290 GOTO 1140
1300 CLS :PRINT "*** CHANGE CAP PI TO CAP TEE ***"
1310 BEEP :PRINT :INPUT "FIRST NODE=";A
1320 PRINT "SECOND NODE=";A+1
1330 CD=C(A)*C(A+1)+C(A+1)*CT(A)+C(A)*CT(A)
1340 CA=CD/C(A+1) :PRINT "C(";A;")=";INT(CA*10^12*1000)/1000;"pf"
1350 CB=CD/C(A) :PRINT "C(";A+1;")=";INT(CB*10^12*1000)/1000;"pf"
1360 CC=CD/CT(A) :PRINT "BOTTOM COUPLING C =";INT(CC*10^12*1000)/1000;"pf"
1370 PRINT :GOTO 1030
1380 CLS :PRINT "*** CHANGE TOP C TO L COUPLED C ***"
1390 BEEP :PRINT:INPUT "FIRST NODE=";A
1400 PRINT "SECOND NODE=";A+1
1410 C(A)=C(A)+CT(A) :PRINT "C(";A;")=";INT(C(A)*10^12*1000)/1000;"pf"
1420 C(A+1)=C(A+1)+CT(A) :PRINT "C(";A+1;")=";INT(C(A+1)*10^12*1000)/1000;"pf"
1430 M=CT(A)*SQR(L(A)*L(A+1))/SQR(C(A)*C(A+1)) :PRINT "M =";M
1440 L(A)=L(A)-M :PRINT "L(";A;")=";INT(L(A)*10^6*1000)/1000;"uh"
1450 L(A+1)=L(A+1)-M :PRINT "L(";A+1;")=";INT(L(A+1)*10^6*1000)/1000;"uh"
1460 PRINT :GOTO 1030
1470 CLS :PRINT "*** CHANGE TOP C TO INDUCTOR TEE ***"
1480 BEEP :PRINT :INPUT "FIRST NODE=";A
1490 PRINT "SECOND NODE=";A+1
1500 C(A)=C(A)+CT(A) :PRINT "C(";A;")=";INT(C(A)*10^12*1000)/1000;"pf"
1510 C(A+1)=C(A+1)+CT(A) :PRINT "C(";A+1;")=";INT(C(A+1)*10^12*1000)/1000;"uh"
1520 M=K(A)*SQR(L(A)*L(A+1)) :PRINT "MUTUAL INDUCTANCE =";M
1530 IF X=5 THEN RETURN
1540 L(A)=L(A)-M :PRINT "L(";A;")=";INT(L(A)*10^6*1000)/1000;"uh"
1550 L(A+1)=L(A+1)-M :PRINT "L(";A+1;")=";INT(L(A+1)*10^6*1000)/1000;"uh"
1560 PRINT :GOTO 1030
1570 CLS :PRINT "*** CHANGE TOP C TO C COUPLED L ***"
1580 BEEP :PRINT :INPUT "FIRST NODE=";A
1590 PRINT "SECOND NODE=";A+1
1600 C(A)=C(A)+CT(A) :PRINT "C(";A;")=";INT(C(A)*10^12*1000)/1000;"pf"
1610 C(A+1)=C(A+1)+CT(A) :PRINT "C(";A+1;")=";INT(C(A+1)*10^12*1000)/1000;"pf"
1620 M=K(A)*SQR(L(A)*L(A+1)) :CM=1/(OM^2*M)
1630 PRINT "CM=";INT(CM*10^12*1000)/1000;"pf"
1640 L(A)=(L(A)+M) :PRINT "L(";A;")=";INT(L(A)*10^6*1000)/1000;"uh"
1650 L(A+1)=(L(A+1)+M) :PRINT "L(";A+1;")=";INT(L(A+1)*10^6*1000)/1000;"uh"
1660 PRINT :GOTO 1030
1670 CLS :PRINT "*** CHANGE TOP C TO M ***"
1680 GOSUB 1480
1690 PRINT "COEFF OF COUPLING=";K(A)
1700 PRINT "L(";A;")=";INT(L(A)*10^6*1000)/1000;"uh"
1710 PRINT "L(";A+1;")=";INT(L(A+1)*10^6*1000)/1000;"uh"
1720 PRINT: GOTO 1030
1730 CLS :PRINT "*** CAPACITIVE DIVIDER ***"
1740 CX=C(U)*SQR(RR(U)/R)/SQR(RR(U)/R-1)
1750 K=C(U)*RR(U)
1760 CC=CX^2/4-(1-OM^2*R*CX*K)/(OM*R)^2
1770 IF CC<=0 THEN PRINT "CANNOT MATCH !!!":GOTO 1130
1780 CY=-CX/2+SQR(CC)
1790 RI=(1+OM^2*R^2*(CY+CX)^2)/(OM^2*R*CX^2)
1800 IF ABS((RR(U)-RI)/RR(U))<.0001 THEN 1820
1810 CX=CX*RI/RR(U) :GOTO 1760
1820 PRINT :PRINT "C(";U;")=";INT(CX*10^12*1000)/1000;"pf"
1830 PRINT "BOTTOM CAP=";INT(CY*10^12*1000)/1000;"pf"
1840 PRINT :RETURN
1850 CLS :PRINT "*** INDUCTIVE DIVIDER ***"
1860 LY=L(U)*SQR(R/RR(U))
1870 K=RR(U)/L(U)
1880 LX=R*LY*(LY*K-R)/((OM*LY)^2+R^2)
1890 IF LX=LL THEN PRINT "CANNOT MATCH !!!":GOTO 1130
1900 RI=((OM*LX*LY)^2+R^2*(LX+LY)^2)/(R*LY^2)
1910 IF ABS ((RR(U)-RI)/RR(U))<.0001 THEN 1940
1920 LY=LY*SQR(RR(U)/RI)
1930 LL=LX :GOTO 1880
1940 PRINT :PRINT "BOTTOM COIL=";INT(LY*10^6*1000)/1000;"uh"
1950 L(U)=LX
1960 PRINT "VALUE OF TOP COIL L(";U;")=";INT(L(U)*10^6*1000)/1000;"uh"
1970 PRINT :RETURN
1980 CLS :PRINT "*** LINK COUPLING ***"
1990 PRINT :BEEP :INPUT "ESTIMATED COUPLING COEFFICIENT =";KK
2000 XX=0
2010 LY=L(U)*R/RR(U)/KK^2
2020 LX=L(U)*((OM*LY)^2*(1-KK^2)+R^2)/((OM*LY)^2*(1-KK^2)^2+R^2)
2030 RI=R*LX/KK^2/LY+OM^2*LX*LY/R*(1-KK^2)^2/KK^2
2040 RM=2*OM*LX*(1-KK^2)/KK^2
2050 IF RM>=.8*RR(U) THEN 2060 ELSE 2070
2060 PRINT "CHOSEN COUPLING COEFFICIENT, ";KK;" IS TOO SMALL !!!":GOTO 1990
2070 IF ABS ((RR(U)-RI)/RR(U))<=.0001 THEN 2090
2080 LY=LY*RI/RR(U) :GOTO 2020
2090 PRINT :PRINT "LX=";LX
2100 PRINT "LY=";LY
2110 PRINT :IF XX=0 THEN GOSUB 3220
2120 RZ=OM*LY/QL
2130 IF XX=0 THEN R=R+RZ:XX=1 :GOTO 2010
2140 PRINT "PRESS Y TO RERUN WITH NEW VALUE OF COUPLING COEFFICIENT." :PRINT
2150 A$=INKEY$ :IF A$="" THEN 2150
2160 IF A$="Y" THEN 1990
2170 RETURN
2180 CLS :PRINT "*** TOP C COUPLING TRANSFORMER ***"
2190 CX=1/OM/SQR(R*(RR(U)-R))
2200 CO=CX/(1+(OM*CX*R)^2)
2210 C(U)=C(U)-CO
2220 PRINT :PRINT "TOP COUPLING C =";INT(CX*10^12*1000)/1000;"pf"
2230 PRINT "NEW C(";U;")=";INT(C(U)*10^12*1000)/1000;"pf"
2240 IF C(U)=<0 THEN PRINT "CANNOT MATCH !!!": C(U)=C(U)+CO :GOTO 1130
2250 RETURN
2260 CLS :PRINT "*** TOP L COUPLING TRANSFORMER ***"
2270 Z=0 :LX=1/OM*SQR(R*(OM*L*Q(U)-R))
2280 PRINT "APPROX. VALUE OF LX=";INT(LX*10^6*1000)/1000;"uh
2290 BEEP :INPUT "APPROX. Q OF LX=";QX$
2300 IF QX$="INF" THEN QX=100000! :GOTO 2320
2310 QX=VAL(QX$)
2320 RI=((R+OM*LX/QX)^2+(OM*LX)^2)/(R+OM*LX/QX)
2330 LO=RI*(R+OM*LX/QX)/(OM^2*LX)
2340 L(U)=1/(1/L-1/LO)
2350 IF Z=1 THEN GOTO 2420
2360 PRINT :PRINT "APPROX. VALUE OF L(";U;") (hy) =";L(U)
2370 IF L(U)=<0 THEN PRINT "CANNOT MATCH !!!" :GOTO 1140
2380 PRINT "Q OF L(";U;")=";
2390 BEEP :INPUT QL$
2400 IF QL$="INF" THEN QL=100000! :GOTO 2420
2410 QL=VAL(QL$)
2420 RY=QL*OM*L(U)
2430 IF L*Q(U)>.8*L(U)*QL THEN PRINT "Q CHOSEN IS TOO SMALL !!!": GOTO 2260
2440 QI=1/(OM*L)/(1/RY+1/RI)
2450 IF ABS((Q(U)-QI)/Q(U))<.0001 THEN 2480
2460 LX=LX*SQR(Q(U)/QI)
2470 Z=1 :GOTO 2320
2480 PRINT :PRINT"LX=";INT(LX*10^6*1000)/1000;"uh"
2490 PRINT "L(";U;")=";INT(L(U)*10^6*1000)/1000;"uh"
2500 PRINT "Q OF L(";U;")=";QL
2510 PRINT "TOTAL Q=";QI
2520 PRINT "LOAD RESISTANCE=";RI
2530 PRINT :BEEP :PRINT "DO YOU WANT TO REPEAT THIS STEP (Y/N)?"
2540 A$=INKEY$ :IF A$="" THEN 2540
2550 IF A$="Y" THEN PRINT :GOTO 2270
2560 RETURN
2570 PRINT :BEEP :PRINT "PRESS <SPACE> TO CONTINUE"
2580 A$=INKEY$ :IF A$="" THEN 2580
2590 PRINT :PRINT "*** COMPUTED INSERTION LOSSES ***"
2600 PRINT :PRINT "ENTER: 1 for PSEUDO-EXACT"
2610 BEEP :INPUT " 0 for ALL OTHERS";P
2620 PRINT :PRINT "PROTOTYPE Q=";QP
2630 Q(1)=Q(1)*W :Q(N)=Q(N)*W
2640 X(1)=Q(1)
2650 RS=1/(1-X(1)/QP)
2660 IF 2*INT(N/2)=N THEN RS=1/RS
2670 IF P=1 THEN RS=1
2680 PRINT "PROTOTYPE RS=";RS
2690 FOR I=1 TO N-1
2700 K(I)=K(I)/W
2710 X(I+1)=1/(K(I)^2*X(I))
2720 NEXT
2730 S=0
2740 FOR I=1 TO N
2750 S=S+X(I)
2760 NEXT
2770 LR=4.343001*S/QP
2780 PRINT "RESISTIVE LOSS (DB)=";INT(LR*100)/100
2790 IF Q(N)=>QP THEN PRINT "MISMATCH LOSS NOT DEFINED" :GOTO 2870
2800 R2=1/(X(N)/Q(N)-X(N)/QP)
2810 IF P=1 THEN R2=Q(N)/X(N)
2820 LM=4.343001*LOG((RS+R2)^2/(4*R2*RS))
2830 PRINT "PROTOTYPE RL=";R2;" OHMS"
2840 PRINT "MISMATCH LOSS (DB)=";INT(LM*1000)/1000
2850 LT=LR+LM
2860 PRINT "INSERTION LOSS (DB)=";INT(LT*1000)/1000
2870 PRINT :PRINT "*** LOWPASS PROTOTYPE VALUES ***"
2880 A=-1*(-1)^N
2890 FOR I=1 TO N
2900 PRINT "X(";I;")=";X(I);
2910 IF A=1 THEN PRINT TAB(20);"R(";I;")=";QP/X(I)
2920 IF A=-1 THEN PRINT TAB(20);"R(";I;")=";X(I)/QP
2930 A=-A
2940 NEXT I
2950 PRINT :BEEP :PRINT "PRESS <SPACE> TO CONTINUE" :PRINT
2960 A$=INKEY$:IF A$="" THEN 2960
2970 PRINT :PRINT "*** APPROXIMATE STOPBAND RESPONSE ***"
2980 BEEP :INPUT "ENTER: 1 FOR CHEBY or MIN-LOSS; 0 FOR OTHERS ";A
2990 X=1: FOR I=1 TO N: X=X*X(I):NEXT
3000 FOR I=20 TO 60 STEP 10
3010 U=I/(8.686001*N)-LOG(2*PI)-1/N*LOG(X)+1/N*LOG((RS+R2)/R2)
3020 F=EXP(U)
3030 BY=BW*2*PI*F*(1+.8499999*N/I*A)
3040 PRINT .1*INT(10*(I-LR)+.5);" DB BW=";INT(BY);" HZ"
3050 NEXT
3060 REM ***** UNLOADED OUTPUT RESISTANCE AT FO *****
3070 IF Q(N)<QP THEN 3210
3080 G(1)=1
3090 FOR I=2 TO N
3100 G(I)=(Q(1)*K(I-1))^2/G(I-1)+RF/RL
3110 NEXT
3120 RO=INT(RF/G(N))
3130 PRINT :PRINT "UNLOADED OUTPUT RESISTANCE AT F0=";RO
3140 BEEP :INPUT "DESIRED OUTPUT RESISTANCE=";RP
3150 IF RO=RP THEN 3210
3160 PRINT "C DIVIDER, C1 BOTTOM, C2 TOP"
3170 C1=C(N)*SQR(RO/RP)
3180 PRINT "C1=";INT(C1*10^12*1000)/1000;"pf"
3190 C2=C(N)*SQR(RO/RP)/(SQR(RO/RP)-1)
3200 PRINT "C2=";INT(C2*10^12*1000)/1000;"pf"
3210 PRINT :PRINT "COMPLETE" :END
3220 REM ***** LINK COIL SUBROUTINE *****
3230 BEEP :INPUT "Q OF LINK COIL=";QL$
3240 IF QL$="INF" THEN QL=100000! :RETURN
3250 QL=VAL(QL$) :RETURN