home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1
/
HamRadio.cdr
/
tech
/
rf4
/
tunedamp.bas
< prev
next >
Wrap
BASIC Source File
|
1986-06-02
|
10KB
|
304 lines
10 REM:PC DOS FIXES BY G.H. 6/2/86:LINE 1440 & 2910
19 CLS
20 PRINT "PLEASE SENT FIXES OR ENHANCEMENTS TO:"
21 PRINT "E.E. PUBLIC DOMAIN LIBRARY"
22 PRINT "36 IRENE LANE E."
23 PRINT "PLAINVIEW,11803,NY"
25 FOR I=1 TO 2000
26 NEXT I
27 I=0
100 'Program TUNEDAMP
110 'Ref: Jack Porter, "Multiple-Tuned Amplifiers",
120 ' r.f. design vol. 6, no. 1, pp. 38-48, Jan/Feb 1983
130 CLEAR
140 DEFINT I-J
150 DIM B(4,2), C(8), G(4,2), M(8), P(8), T$(21), Y(8,20), Y$(8)
160 FOR J1=1 TO 8: READ Y$(J1): NEXT J1
170 DATA "11", "21", "12", "22", "ia", "oa", "ib", "ob"
180 PI=3.14159: DP=10/LOG(10)
190 'Read transistor data in data statements beginning at line 3000
200 FOR J5=1 TO 21
210 READ T$(J5)
220 IF T$(J5)="***" THEN 260
230 FOR J1=1 TO 8
240 READ Y(J1,J5)
250 NEXT J1, J5
260 J5=J5-1
270 F1$="TUNED AMPLIFIERS"
280 F2$=CHR$(13)
290 F3$="Transistors"
300 F6$="Prototype element values"
310 F7$="Y\\= +#.###^^^^ +#.###^^^^j"
320 'Enter Am=0 for Butterworth filters, Am=-1 to enter prototype
330 ' values from the keyboard, e.g. for Bessel filters
340 CLS: PRINT F1$; TAB(60) DATE$: INPUT "N, Am(dB)"; N%, A1
350 IF N%<1 THEN 4000
360 I1=0: I3=0: A6=0: A7=0: R3=1
370 IF A1>=0 THEN 440
380 PRINT F6$
390 FOR J1=1 TO N%
400 PRINT J1;: INPUT P(J1)
410 NEXT J1
420 GOTO 720
430 'Calculate prototype element values for Butterworth and Chebyshev filters
440 FOR J1=1 TO N%
450 P(J1)=2*SIN((2*J1-1)*PI/(2*N%))
460 NEXT J1
470 IF A1=0 THEN 720
480 INPUT "Specify: 1. Ripple BW 2. 3 dB BW"; I3
490 A2=EXP(A1/DP): A3=2
500 B2=LOG(1+2/(SQR(A2)-1))/2
510 X1=EXP(B2/N%)
520 G1=(X1-1/X1)/2: G2=G1*G1
530 U1=P(1): P(1)=U1/G1
540 IF N%<2 THEN 650
550 FOR J1=2 TO N%
560 U2=P(J1)
570 T1=SIN((J1-1)*PI/N%)
580 B1=G2+T1*T1
590 P(J1)=U1*U2/(B1*P(J1-1))
600 U1=U2
610 NEXT J1
620 IF N%>2*INT(N%/2) THEN 650
630 T1=1-2/(EXP(B2)+1)
640 R3=T1*T1: A3=A3*A2: A6=A1
650 IF I3<2 THEN 720
660 T1=SQR((A3-1)/(A2-1))
670 T2=LOG(T1+SQR(T1*T1-1))
680 X1=EXP(T2/N%): W1=(X1+1/X1)/2
690 FOR J1=1 TO N%
700 P(J1)=W1*P(J1)
710 NEXT J1
720 IF N%<3 THEN 760
730 FOR J1=2 TO N%-1
740 A7=A7+P(J1)
750 NEXT J1
760 PRINT F6$; ":"
770 FOR J1=1 TO N%: PRINT J1; P(J1),: NEXT J1
780 PRINT F2$; " r="; R3
790 PRINT: INPUT "Print element values"; I$
800 IF LEFT$(I$,1)="Y" THEN GOSUB 2600
810 CLS: PRINT F1$; " N="; N%; " Am="; A1; TAB(60) DATE$
820 PRINT F3$; ":"
830 J2=1: J6=42
840 FOR J1=1 TO J5
850 PRINT TAB(J2) STR$(J1); ". "; T$(J1);
860 J2=J6-J2
870 IF J2=1 THEN PRINT
880 NEXT J1
890 IF J2>1 THEN PRINT
900 PRINT "Coupling network types:"
910 INPUT "1. Interstage 2. Input 3. Output"; I1
920 ON I1+2 GOTO 4000, 340, 930, 950, 950
930 PRINT F3$;: INPUT I5, I6
940 GOTO 970
950 INPUT "Transistor"; I5
960 I6=I5
970 FOR J1=1 TO 4
980 IF I1=2 THEN 1010
990 G(J1,1)=Y(2*J1-1,I5): B(J1,1)=Y(2*J1,I5)
1000 IF I1=3 THEN 1020
1010 G(J1,2)=Y(2*J1-1,I6): B(J1,2)=Y(2*J1,I6)
1020 NEXT J1
1030 ON I1 GOTO 1040, 1080, 1140
1040 INPUT "Mia, Moa, Mib, Mob"; M3, M1, M2, M4
1050 GOSUB 2040
1060 PRINT "Ka="; K1; " Sa="; S1; TAB(42) "Kb="; K2; " Sb="; S2
1070 GOTO 1180
1080 INPUT "GS, BS, MS, Mib, Mob"; G(4,1), B(4,1), M1, M2, M4
1090 G1=G(4,1): B1=B(4,1)
1100 G3=G1: Y2=4
1110 GOSUB 2150
1120 PRINT "K="; K2, "S="; S2
1130 GOTO 1180
1140 INPUT "Mia, Moa, ML, GL, BL"; M3, M1, M2, G(1,2), B(1,2)
1150 G2=G(1,2): B2=B(1,2)
1160 GOSUB 2040
1170 PRINT "K="; K1, "S="; S1
1180 INPUT "Are K and S OK"; I$
1190 IF LEFT$(I$,1)="N" THEN 1030
1200 IF I1=2 THEN 1220
1210 Y2=(G(2,1)*G(2,1)+B(2,1)*B(2,1))/(G(4,1)*G(4,1))
1220 CLS: PRINT F1$; " N="; N%; " Am="; A1; TAB(60) DATE$
1230 IF I1=1 THEN PRINT "Transistors:": ELSE PRINT "Transistor:"
1240 PRINT STR$(I5); ". "; T$(I5);
1250 IF I1=1 THEN PRINT TAB(41) STR$(I6); ". "; T$(I6): ELSE PRINT
1260 ON I1 GOTO 1270, 1320, 1350
1270 PRINT "Mia="; M3; TAB(20) "Moa="; M1;
1280 PRINT TAB(40) "Mib="; M2; TAB(60) "Mob="; M4
1290 PRINT " Ka="; K1; TAB(20) " Sa="; S1;
1300 PRINT TAB(40) " Kb="; K2; TAB(60) " Sb="; S2
1310 GOTO 1370
1320 PRINT " MS="; M1; TAB(40) "Mib="; M2; TAB(60) "Mob="; M4
1330 PRINT TAB(40) " K="; K2; TAB(60) " S="; S2
1340 GOTO 1370
1350 PRINT "Mia="; M3; TAB(20) "Moa="; M1; TAB(40) " ML="; M2
1360 PRINT " K="; K1; TAB(20) " S="; S1
1370 PRINT
1380 INPUT "F0(MHz), BW(MHz), Qu"; F0, B0, Q3
1390 T1=B0/2
1400 F1=SQR(F0*F0-T1*T1)
1410 W0=.000002*PI*F1: Q0=F1/B0
1420 Q1=Q0*P(1): Q2=Q0*P(N%)/R3
1430 A8=A6+DP*A7*Q0/Q3
1440 REM: PRINT @ (7,0), CHR$(31);: 'Clear screen starting at line 8
1450 PRINT "Options: 1. Select C12 2. Select Ct";
1460 INPUT " 3. N1=1 4. N2=1"; I2
1470 ON I2 GOTO 1480, 1510, 1520, 1540
1480 IF N%=1 THEN 1510
1490 INPUT "C12(pF)"; X1
1500 C0=X1*Q0*SQR(P(1)*P(2)): GOTO 1560
1510 INPUT "Ct(pF)"; C0: GOTO 1560
1520 X1=(M1*G(4,1)+G1)/2
1530 C0=Q1*X1/W0: GOTO 1560
1540 X1=(M2*G(1,2)+G2)/2
1550 C0=Q2*X1/W0
1560 X1=W0*C0
1570 L1=.001/(W0*X1)
1580 G5=X1/Q1: G6=X1/Q2
1590 N3=(M1*G(4,1)+G1)/(2*G5)
1600 N1=SQR(N3)
1610 N4=(M2*G(1,2)+G2)/(2*G6)
1620 N2=SQR(N4)
1630 G7=G5*(1-Q1/Q3)-G1/N3
1640 G8=G6*(1-Q2/Q3)-G2/N4
1650 IF N%=1 THEN G7=G7+G8+X1/Q3
1660 M(0)=B1/(W0*N3)
1670 M(N%)=B2/(W0*N4)
1680 R1=1/G7
1690 IF N%=1 THEN 1740
1700 R2=1/G8: T1=C0/Q0
1710 FOR J1=1 TO N%-1
1720 M(J1)=T1/SQR(P(J1)*P(J1+1))
1730 NEXT J1
1740 FOR J1=1 TO N%
1750 C(J1)=C0-M(J1-1)-M(J1)
1760 NEXT J1
1770 X2=1+M1
1780 X1=Y2/(X2*X2)
1790 X2=N3*G5*G2/(N4*G6*G3)
1800 A5=DP*LOG(X1*X2)-A8
1810 PRINT "Fc="; F1; "MHz",,
1820 IF I1=2 THEN PRINT "Ap(Transducer)="; A5; "dB": ELSE PRINT "Ap="; A5; "dB"
1830 IF N%=1 THEN PRINT "QL="; Q1/2,: ELSE PRINT "Q1="; Q1, "Q2="; Q2,
1840 PRINT "Qu="; Q3
1850 PRINT "R1="; R1,
1860 IF N%=1 THEN PRINT,: ELSE PRINT "R2="; R2,
1870 PRINT "N1="; N1, "N2="; N2
1880 PRINT " L="; L1; "nH", "Ct="; C0; "pF"
1890 FOR J1=1 TO N%
1900 PRINT "C"; J1; "="; C(J1),
1910 NEXT J1: PRINT
1920 IF N%=1 THEN 1970
1930 FOR J1=1 TO N%-1
1940 J2=11*J1+1
1950 PRINT "C"; J2; "="; M(J1),
1960 NEXT J1
1970 PRINT F2$: INPUT "Print results"; I$
1980 IF LEFT$(I$,1)="Y" THEN GOSUB 2270
1990 INPUT "New C"; I$
2000 IF LEFT$(I$,1)="Y" THEN 1440
2010 INPUT "New M's"; I$
2020 IF LEFT$(I$,1)="Y" THEN 1030: ELSE 810
2030 'Subroutines for input & output impedances and stability factors
2040 T1=G(2,1)*G(3,1)-B(2,1)*B(3,1)
2050 T2=G(2,1)*B(3,1)+G(3,1)*B(2,1)
2060 T3=SQR(T1*T1+T2*T2)
2070 X1=(1+M3)*G(1,1)
2080 G1=G(4,1)-T1/X1: B1=B(4,1)-T2/X1
2090 X2=(1+M1)*G(4,1)
2100 G3=G(1,1)-T1/X2: B3=B(1,1)-T2/X2
2110 X2=X2*X1: K1=2*X2/(T1+T3)
2120 X1=X2-T1: X2=X1*X1+T2*T2
2130 S1=T3/SQR(X2)
2140 IF I1>1 THEN 2250
2150 T4=G(2,2)*G(3,2)-B(2,2)*B(3,2)
2160 T5=G(2,2)*B(3,2)+G(3,2)*B(2,2)
2170 T6=SQR(T4*T4+T5*T5)
2180 X1=(1+M4)*G(4,2)
2190 G2=G(1,2)-T4/X1: B2=B(1,2)-T5/X1
2200 X2=(1+M2)*G(1,2)
2210 G4=G(4,2)-T4/X2: B4=B(4,2)-T5/X2
2220 X2=X2*X1: K2=2*X2/(T4+T6)
2230 X1=X2-T4: X2=X1*X1+T5*T5
2240 S2=T6/SQR(X2)
2250 RETURN
2260 'Line printer output subroutines
2270 IF I7=0 THEN GOSUB 2900
2280 LPRINT: IF I1=1 THEN LPRINT F3$+":": ELSE LPRINT "Transistor:"
2290 IF I1=2 THEN 2320
2300 LPRINT T$(I5);
2310 IF I1=3 THEN 2330
2320 LPRINT TAB(40) T$(I6);
2330 LPRINT: FOR J1=1 TO 4
2340 IF I1=2 THEN 2370
2350 LPRINT USING F7$; Y$(J1); Y(2*J1-1,I5); Y(2*J1,I5);
2360 IF I1=3 THEN 2380
2370 LPRINT TAB(40) USING F7$; Y$(J1); Y(2*J1-1,I6); Y(2*J1,I6);
2380 LPRINT: NEXT J1
2390 LPRINT: ON I1 GOTO 2400, 2490, 2550
2400 LPRINT "Mia="; M3; TAB(20) "Moa="; M1;
2410 LPRINT TAB(40) "Mib="; M2; TAB(60) "Mob="; M4
2420 LPRINT " Ka="; K1; TAB(20) " Sa="; S1;
2430 LPRINT TAB(40) " Kb="; K2; TAB(60) " Sb="; S2
2440 LPRINT USING F7$; Y$(5); G3; B3;
2450 LPRINT TAB(40) USING F7$; Y$(7); G2; B2
2460 LPRINT USING F7$; Y$(6); G1; B1;
2470 LPRINT TAB(40) USING F7$; Y$(8); G4; B4
2480 GOTO 2600
2490 LPRINT " MS="; M1; TAB(40) "Mib="; M2; TAB(60) "Mob="; M4
2500 LPRINT TAB(40) " K="; K2; TAB(60) " S="; S2
2510 LPRINT " GS="; G(4,1); TAB(20) " BS="; B(4,1);
2520 LPRINT TAB(40) USING F7$; Y$(7); G2; B2
2530 LPRINT TAB(40) USING F7$; Y$(8); G4; B4
2540 GOTO 2600
2550 LPRINT "Mia="; M3; TAB(20) "Moa="; M1; TAB(40) " ML="; M2
2560 LPRINT " K="; K1; TAB(20) " S="; S1
2570 LPRINT USING F7$; Y$(5); G3; B3
2580 LPRINT USING F7$; Y$(6); G1; B1;
2590 LPRINT TAB(40) " GL="; G(1,2); TAB(60) " BL="; B(1,2)
2600 IF I7=0 THEN GOSUB 2900
2610 LPRINT F2$; " N="; N%;
2620 IF A1>=0 THEN LPRINT TAB(20) " Am="; A1; "dB";
2630 IF I3=1 THEN LPRINT TAB(40) "Ripple BW";
2640 IF I3=2 THEN LPRINT TAB(40) "3 dB BW";
2650 LPRINT: IF I1>0 THEN 2740
2660 J2=0: LPRINT F6$; ":"
2670 FOR J1=1 TO N%
2680 LPRINT TAB(J2) J1; P(J1);
2690 J2=J2+20: IF J2>60 THEN J2=0: LPRINT
2700 NEXT J1
2710 IF J2>0 THEN LPRINT
2720 LPRINT " r="; R3
2730 RETURN
2740 LPRINT " F0="; F0; "MHz"; TAB(20) " BW="; B0; "MHz";
2750 LPRINT TAB(40) " Fc="; F1; "MHz"
2760 IF I1=2 THEN LPRINT " Ap(Transducer)="; A5; "dB": ELSE LPRINT " Ap="; A5; "dB"
2770 IF N%=1 THEN LPRINT " QL="; Q1/2;: ELSE LPRINT " Q1="; Q1; TAB(20) " Q2="; Q2;
2780 LPRINT TAB(40) " Qu="; Q3; F2$; " R1="; R1; CHR$(182);
2790 IF N%>1 THEN LPRINT TAB(20) " R2="; R2; CHR$(182): ELSE LPRINT
2800 LPRINT " N1="; N1; TAB(20) " N2="; N2
2810 LPRINT F2$; " L="; L1; "nH"; TAB(20) " Ct="; C0; "pF"
2820 FOR J1=1 TO N%
2830 T1$=" C"+RIGHT$(STR$(J1),1)+"="
2840 LPRINT T1$; C(J1); "pF"
2850 IF J1=N% THEN 2880
2860 T1$="C"+RIGHT$(STR$(11*J1+1),2)+"="
2870 LPRINT TAB(20) T1$; M(J1); "pF"
2880 NEXT J1
2890 LPRINT CHR$(12): I7=0: RETURN
2900 IF I8=1 THEN 2950
2910 REM: SYSTEM "FORMS (R,L=60)": 'Set 60 lines/page
2920 LPRINT CHR$(27)+CHR$(64); CHR$(27)+CHR$(66)+CHR$(2);: 'Set 12 char/in
2930 LPRINT CHR$(27)+CHR$(77)+CHR$(10);: 'Set left margin to col 10
2940 LPRINT CHR$(27)+CHR$(81)+CHR$(89);: I8=1: 'Set line length to 80 char
2950 LPRINT F2$; CHR$(14); F1$; TAB(27) DATE$: I7=1: RETURN: 'Double-width mode
3000 DATA "MRF904 10V 2.5mA 180 MHz"
3010 DATA 1.730E-3, 5.063E-3, 6.583E-2, -2.481E-2
3020 DATA -2.305E-5, -5.248E-4, 7.946E-5, 1.590E-3
3030 DATA "2N4957 10V 2.0mA 180 MHz"
3040 DATA 2.585E-3, 6.348E-3, 5.396E-2, -2.084E-2
3050 DATA -7.264E-8, -4.480E-4, 1.397E-4, 1.296E-3
3990 DATA "***"
4000 END