1 COMMON A, AL, B, BASEONLY, C, C$, C1, CAT$, CC, CKT$, D, D$, DD, DIA, DIMN$, DMS, E, EO, EX$, F, F$, FD, FF, FQ, FRQ, G$, GO$, I, I$, L, LATLONG, LD, LL, LN, LS, LW, LX, MAX, MENU, MIN, MX, N, NN, NT, OV, P, PI, PROG$, Q, QQ, QU, R, RA, RC, T, T$, U, U$, UH, UL$, V$, VC, W, WHIP, WIRD, WW, X, X$, X1, XS, Z$, ZP, ZS
10 'LOPASS - SALLEN and KEY Lowpass Active Filter - 30 OCT 95 rev. 05 APR 1999
20 IF EX$=""THEN EX$="EXIT"
30 CLS:KEY OFF
40 COLOR 7,0,0
50 PI=3.141592
60 U1$="#####.###"
70 UL$=STRING$(80,205)
80 E$=STRING$(79,32)
90 '
100 '.....start
110 COLOR 15,2
120 FOR Z=1 TO 2:PRINT STRING$(80,32);:NEXT Z
130 LOCATE 1,2
140 PRINT "THIRD ORDER SALLEN & KEY LOWPASS ACTIVE FILTER";
150 PRINT " with single rail DC supply";
160 LOCATE 2,2:PRINT "by Brian Egan ZL1LE"
170 LOCATE 2,38:PRINT "edited for HAMCALC by George Murphy VE3ERP"
180 COLOR 1,0:PRINT STRING$(80,223);:COLOR 7,0
190 GOSUB 1690  'draw diagram
200 PRINT UL$;
210 '
220 '.....input data
230 PRINT " Press number in < > to select filter type:"
240 PRINT UL$;
250 PRINT "   <1>  BUTTERWORTH"
260 PRINT "   <2>  CHEBYSHEV"
270 PRINT UL$;
280 PRINT "    or Press <0> to EXIT"
290 F$=INKEY$
300 IF F$="0" THEN CLS:RUN EX$
310 IF F$="1" THEN N$=" BUTTERWORTH LOWPASS FILTER ":GOSUB 1210:GOTO 400
320 IF F$="2" THEN N$=" CHEBYSHEV LOWPASS FILTER ":GOSUB 1370:GOTO 400
330 GOTO 290
340 '
350 '.....format input line
360 LOCATE CSRLIN-1:PRINT SPC(10);
370 LOCATE CSRLIN,50:PRINT STRING$(7,".");USING U1$;ZZ;
380 RETURN
390 '
400 '.....calculate component values
410 A1=1/RP+QUOT/WP2:A2=1/WP2+QUOT/RP/WP2:A3=1/RP/WP2
420 X0=A1/2:P=A1*A2-A3:ITER=1
430 U1=A1-X0:U2=A2+2*U1*U1
440 F=X0-P/U2:DF=1-4*P*U1/U2^2
450 X1=X0-F/DF
460 IF ABS(X1-X0)<10^-8 THEN 480
470 X0=X1:GOTO 430
480 T3=X1
490 R3C=T3*10^6
500 PRINT TAB(12);;"Product of R3 (Kê) x C (nF)..................";USING U1$;R3C
510 LN=CSRLIN
520 '
530 INPUT "    ENTER: Value of C..............................(nF)";C
540 ZZ=C:GOSUB 350:PRINT " nF"
550 R3=T3*10^6/C:T1=A1-T3:R1=T1*10^6/C:T2=A3/T3/(A1-T3):R2=T2*10^6/C
560 '
570 Y=2*R1
580 PRINT TAB(12);;"Value of R1a, R1b............................";USING U1$;Y;
590 PRINT " Kê"
600 '
610 PRINT TAB(12);;"Value of R2..................................";USING U1$;R2;
620 PRINT " Kê"
630 '
640 PRINT TAB(12);;"Value of R3..................................";USING U1$;R3;
650 PRINT " Kê"
660 '
670 LOCATE 25,17
680 COLOR 0,7:PRINT " Do you wish to vary the filter design?   (y/n) ";
690 COLOR 7,0
700 Y$=INKEY$:IF Y$=""THEN 700
710 IF Y$="y" OR Y$="Y" THEN 720 ELSE GOTO 760
720 VIEW PRINT LN TO 24:CLS:VIEW PRINT:LOCATE LN+2
730 PRINT TAB(12);;"(Previous selection for C was";C;;" nF)"
740 LOCATE LN:GOTO 530
750 '
760 LOCATE 25,1:PRINT E$;
770 GOSUB 1980   'hard copy option
780 LOCATE 25,1:PRINT E$;
790 LOCATE 25,12:COLOR 0,7
800 PRINT " Press 1 to QUIT, or 2 to tabulate filter response ......";
810 COLOR 7,0
820 Y$=INKEY$:IF Y$="" THEN 820
830 IF Y$="1"THEN 1950
840 IF Y$="2"THEN 870
850 GOTO 820
860 '
870 '.....filter frequency response
880 CLS:COLOR 7,0
890 LOCATE 1,8
900 PRINT "THIRD ORDER SALLEN & KEY LOWPASS ACTIVE FILTER FREQUENCY RESPONSE"
910 PRINT UL$;
920 PRINT TAB((80-LEN(N$))/2);N$
930 PRINT UL$;
940 PRINT TAB(4);
950 PRINT "FREQUENCY (Hz)";TAB(22);;"RESPONSE (dB)";TAB(42);;"FREQUENCY (Hz)";
960 PRINT TAB(60);;"RESPONSE (dB)"
970 PRINT TAB(4);
980 PRINT "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄ";TAB(22);;"ÄÄÄÄÄÄÄÄÄÄÄÄÄ";TAB(42);;"ÄÄÄÄÄÄÄÄÄÄÄÄÄÄ";
990 PRINT TAB(60);;"ÄÄÄÄÄÄÄÄÄÄÄÄÄ"
1000 K1=K*WP^3
1010 F1=INT(FP/10):FF=INT((FP-F1)/13):F2=FP
1020 '
1030   FOR FREQ=F1 TO F2 STEP FF
1040 W=2*PI*FREQ:RN=WP2-W^2:IN=QUOT*W
1050 AV=K1/SQR(RN^2+IN^2)/SQR(RP^2+W^2):DB=20*LOG(AV)/2.302999
1060 PRINT TAB(9);:PRINT USING "####";FREQ;:PRINT TAB(25);USING "###.##";DB
1070   NEXT FREQ
1080 '
1090 N=1:F1=FP:F2=5*FP
1100 '
1110   FOR FREQ=F1 TO F2 STEP INT((F2-F1)/13)
1120 W=2*PI*FREQ:RN=WP2-W^2:IN=QUOT*W
1130 AV=K1/SQR(RN^2+IN^2)/SQR(RP^2+W^2):DB=20*LOG(AV)/2.302999
1140 LOCATE 6+N,46:PRINT USING "#####";FREQ;:PRINT TAB(63);USING "###.##";DB
1150 N=N+1
1160   NEXT FREQ
1170 '
1180 GOSUB 1980
1190 GOTO 1950
1200 '
1210 '.....Butterworth filter design
1220 VIEW PRINT 2 TO 24:CLS:VIEW PRINT
1230 LOCATE 2:COLOR 1,0:PRINT STRING$(80,223);
1240 GOSUB 1690
1250 T=30-LEN(N$)/2
1260 COLOR 0,7:LOCATE CSRLIN,T:PRINT N$:COLOR 7,0
1270 INPUT "    ENTER: Filter passband width...................(Hz)";FP
1280 ZZ=FP:GOSUB 350:PRINT " Hz"
1290 INPUT "    ENTER: Falloff in response at passband edge....(dB)";ADB
1300 ZZ=ADB:GOSUB 350:PRINT " dB"
1310 EPSILON=SQR(10^(ADB/10)-1)
1320 FACTOR=1/(EPSILON^(1/3))
1330 WP=2*PI*FP
1340 RP=FACTOR*WP:QUOT=RP:WP2=RP^2:K=1/EPSILON
1350 RETURN
1360 '
1370 '     Chebyshev filter design
1380 VIEW PRINT 2 TO 24:CLS:VIEW PRINT
1390 LOCATE 2:COLOR 1,0:PRINT STRING$(80,223);
1400 GOSUB 1690
1410 T=30-LEN(N$)/2
1420 COLOR 0,7:LOCATE CSRLIN,T:PRINT N$:COLOR 7,0
1430 INPUT "    ENTER: Filter passband width...................(Hz)";FP
1440 ZZ=FP:GOSUB 350:PRINT " Hz"
1450 INPUT "    ENTER: Passband ripple (0.5, 1.0 or 2.0).......(dB)";ADB
1460 IF ADB=5.000000E-01 OR ADB=1 OR ADB=2 THEN 1480
1470 BEEP:LOCATE CSRLIN-1:PRINT E$:LOCATE CSRLIN-1:GOTO 1450
1480 ZZ=ADB:GOSUB 350
1490 LOCATE CSRLIN,28:PRINT ".................";
1500 LOCATE CSRLIN,66:PRINT " dB"
1510 WP=2*PI*FP
1520 IF ADB = 5.000000E-01 THEN GOSUB 1570
1530 IF ADB=1 THEN GOSUB 1610
1540 IF ADB=2 THEN GOSUB 1650
1550 RETURN
1560 '
1570 '.....ADB= O.5 dB
1580 RP=WP*6.264600E-01:QUOT=WP*6.264600E-01:WP2=1.142449*WP^2:K=7.156999E-01
1590 RETURN
1600 '
1610 '.....ADB=1 dB
1620 RP=WP*4.941700E-01:QUOT=WP*4.941700E-01:WP2=9.941999E-01*WP^2:K=4.912999E-01
1630 RETURN
1640 '
1650 '.....ADB=2 dB
1660 RP=WP*3.689100E-01:QUOT=WP*3.689100E-01:WP2=8.860999E-01*WP^2:K=3.268899E-01
1670 RETURN
1680 '
1690 '......schematic diagram
1700 COLOR 0,7
1710 T=2
1720 LOCATE,T:PRINT "       R6 100 K                                          "
1730 LOCATE,T:PRINT "      ÚÄÄ\/\/\ÄÂÄÄÄ + V                 C                "
1740 LOCATE,T:PRINT "   C1 ³ ÚÄÄÄÄ¿ ³               ÚÄÄÄÄÄÄÄÄ×ÄÄÄÄÄÄÄÄÄ¿      "
1750 LOCATE,T:PRINT " ¯Ä×ÄÂÁÄ´3  8ÃÄÙ  R1a     R2   ³  R3       ÚÄÄÄÄ¿ ³      "
1760 LOCATE,T:PRINT "  1æF³ U1a  1ÃÄÂÄ\/\/\ÄÂÄ\/\/\ÄÁÄ\/\/\ÄÂÄÄÄ´5   ³ ³  C2  "
1770 LOCATE,T:PRINT "     ³ Ú´2   ³ ³       ³   C       C   ³  U1b  7ÃÄÁÂÄ×Ä¯ "
1780 LOCATE,T:PRINT "     ³ ³À-4ÂÄÙ ³       ÃÄÄÄ×ÄÄÄÂÄÄÄ×ÄÄÄÙ ÚÄ´6   ³  ³1æF  "
1790 LOCATE,T:PRINT "     ³ ³  \\\  ³       ³       ³         ³ ÀÄÄÄÄÙ  ³     "
1800 LOCATE,T:PRINT "     ³ ÀÄÄÄÄÄÄÄÙ  R1b  ³       ³   R5    ³   R4    ³     "
1810 LOCATE,T:PRINT "     ÀÄÄÄ\/\/\ÄÂÄ\/\/\ÄÙ       ÃÄÄ\/\/\ÄÄÁÄÄ\/\/\ÄÄÙ     "
1820 LOCATE,T:PRINT "      R7 100 K ³               ³   10 K      10 K        "
1830 LOCATE,T:PRINT "              \\\             \\\                        "
1840 LOCATE,T:PRINT "           U1a, U1b = Dual op-amp (e.g. 1458)            "
1850 LN=CSRLIN:COLOR 7,0
1860 LOCATE 7,59:PRINT " Inverting Inputs:"
1870 LOCATE 8,59:PRINT "   Pins 2 and 6"
1880 LOCATE 10,59:PRINT " Non-Inverting Inputs:"
1890 LOCATE 11,59:PRINT "   Pins 3 and 5"
1900 LOCATE LN
1910 RETURN
1920 '
1930 '.....end
1940 GOSUB 1980
1950 CLS:GOTO 100
1960 END
1970 '
1980 'PRT
1990 KEY OFF:GOSUB 2060:LOCATE 25,5:COLOR 0,2
2000 PRINT " Send this page to:(1)Printer Queue? (2)Printout? ";
2010 PRINT "(3)Next page? (1/2/3)";:COLOR 7,0
2020 Z$=INKEY$:IF Z$<"1"OR Z$>"3"THEN 2020 ELSE GOSUB 2060
2030 IF Z$="3"THEN RETURN
2040 FOR I%=1 TO 24:FOR J%=1 TO 80:LPRINT CHR$(SCREEN(I%,J%));:NEXT J%:NEXT I%
2050 IF Z$="2"THEN LPRINT CHR$(12) ELSE 1990
2060 LOCATE 25,1:PRINT STRING$(80,32);:RETURN
