100 REM BUTTER.BAS
105 CLS:PRINT"THIS PROGRAM COMPUTES THE CAPACITANCE VALUES FOR LOW PASS,"
110 PRINT"OR THE RESISTANCE VALUES FOR HIGH PASS, ACTIVE BUTTERWORTH"
120 PRINT"FILTERS. YOU MUST CHOOSE: THE RESISTANCE VALUE FOR THE LOW PASS,"
130 PRINT"OR THE CAPACITANCE VALUE FOR THE HIGH PASS FILTERS AND; THE NUMBER"
140 PRINT"OF POLES BETWEEN 2 AND 10."
150 PRINT"EVEN ORDERED FILTERS MUST BE MADE WITH TWO POLE SECTIONS."
160 PRINT"ODD ORDERED FILTERS WILL HAVE A SINGLE 3 POLE SECTION. THE"
170 PRINT"3 POLE VALUES ARE ALWAYS THE LAST 3."
180 REM
190 REM WRITTEN BY RUSSELL KINCAID, JUNE 1968, REVISED AUG 2000,JAN 2001
200 REM
204 LET P1=6.28318
210 PRINT:INPUT"HIGH PASS (1 ) OR LOW PASS (2)";Y1
240 PRINT"GIVE THE VALUES FOR THESE PARAMETERS:"
242 INPUT"NUMBER OF POLES:";N
243 INPUT"CUTOFF FREQ IN HZ:";W
244 IF Y1=2 THEN 280
245 INPUT"CAPACITANCE IN FARADS:";R1
250 GOTO 300
280 INPUT"OHMS RESISTANCE:";R1
300 DATA 1.4142,1,.7654,1.8478,.6180,1.6180,.5176,1.4142,1.9319,.4450
310 DATA 1.2470,1.8019,.3902,1.1111,1.1663,1.9616,.3473,1,1.5321,1.8794
320 DATA .3129,.9080,1.4142,1.7820,1.9754
330 FOR N1=2 TO N :
340 LET B6=INT(N1-1)/2+.5
350 FOR K1=1 TO B6
360 READ A(N1,K1)
370 REM IF N1=N THEN 410
380 IF K1=B6 THEN 395
390 NEXT K1
395 IF N1=N THEN 410
400 NEXT N1
410 LET B6=INT((N-1)/2+.5)
420 FOR K=1 TO B6
430 LET A=A(N,K)
440 LET B=2*K-1
450 LET D=2*K
460 LET C(B)=2/A
470 LET C(D)=A/2
480 IF 2*K=N THEN 510
490 IF K=N/2-.5 THEN 690
500 NEXT K
510 IF Y1=1 THEN 570
520 PRINT
530 PRINT"CAPACITANCE IN FARADS"
540 PRINT
550 REM
560 GOTO 600
570 PRINT
580 PRINT"RESISTANCE IN OHMS"
590 PRINT
600 FOR T=1 TO N
620 IF Y1=1 THEN 660
630 PRINT"C(";T;")= ";C(T)/(P1*R1*W)
640 GOTO 670
660 PRINT" R (";T;")= ";1/(C(T)*P1*R1*W)
670 IF T=N THEN 1100
680 NEXT T
690 LET Q=N-1
700 LET U=N-2
710 REM THIS PROGRAM SOLVES FOR THE ROOTS OF A CUBIC EQUATION
720 LET A2=-(A+1)
730 LET A1=3*(A+1)/2
740 LET A0=-3
750 LET J=1
760 DEF FNF(X)=X^3+A2*X^2+A1*X+A0
770 LET A4=10^10
780 IF FNF(A4)>0 THEN 810
790 LET A5=-1
800 GOTO 820
810 LET A5=+1
820 LET A3=-(10^10)
830 IF A5*FNF(A3)<0 THEN 860
840 PRINT"AT LEAST ONE REAL ROOT IS >10^10 OR <-10^10. TOUGH LUCK."
850 GOTO 1100
860 LET A9=A6
870 LET A6=(A4+A3)/2
880 IF A6=A9 THEN 960
890 LET J=1
900 IF ABS (FNF(A6))<1/(10^20) THEN 990
910 IF A5*FNF(A6)>0 THEN 940
920 LET A3=A6
930 GOTO 860
940 LET A4=A6
950 GOTO 860
960 IF J>100 THEN 990
970 LET J=J+1
980 GOTO 910
990 LET A9=(A2+A6)^2/4-A1-A2*A6-A6*A6
1000 IF A9<0 THEN 1060
1010 LET A7=-(A2+A6)/2+SQR(A9)
1020 LET A8=-(A2+A6)/2-SQR(A9)
1030 PRINT" C2= ;A6;" OR ";A7
1040 PRINT"THE RESIDUAL FIRST ROOT ERROR IS: ";FNF(A6)
1050 STOP
1060 LET C(U)=A6
1070 LET C(N)=(A+1-A6)/3
1080 LET C(Q)=1/(A6*C(N))
1090 GOTO 510
1100 INPUT"DO YOU WANT A HARDCOPY ";Y$
1105 IF LEFT$(Y$,1)="N" OR LEFT$(Y$,1)="n" THEN 3000
1110 IF Y1=1 THEN 1170
1120 LPRINT
1130 LPRINT"CAPACITANCE IN FARADS"
1140 LPRINT
1150 REM
1160 GOTO 2000
1170 LPRINT
1180 LPRINT"RESISTANCE IN OHMS"
1190 LPRINT
2000 FOR T=1 TO N
2020 IF Y1=1 THEN 2060
2030 LPRINT"C(";T;")= ";C(T)/(P1*R1*W)
2040 GOTO 2070
2060 LPRINT" R (";T;")= ";1/(C(T)*P1*R1*W)
2070 IF T=N THEN 2090
2080 NEXT T
2090 LPRINT"THIS IS THE SCHEMATIC, ELIMINATE THE 3 POLE SECTION "
2092 LPRINT"FOR EVEN NUMBERS OF POLES. "
2094 IF Y1=2 THEN 2200
2100 LPRINT :LPRINT"C=";R1 :LPRINT
2110 LPRINT" ------------------ -----------------"
2120 LPRINT" | | | |"
2130 LPRINT" R1 | R(n-1) |"
2140 LPRINT" | | | |"
2150 LPRINT"IN--C-- --C-- --AMP(+1)-- - * * * --C-- --C-- --C-- --AMP(+1)-- OUT"
2160 LPRINT" | | |"
2170 LPRINT" R2 R(n-2) Rn"
2180 LPRINT" | | |"
2190 LPRINT" GND GND GND"
2192 LPRINT" n/2 TWO POLE SECTIONS THREE POLE SECTION"
2194 GOTO 2300
2200 LPRINT:LPRINT"R=";R1:LPRINT
2210 LPRINT" ------------------ -----------------"
2220 LPRINT" | | | |"
2230 LPRINT" C1 | C(n-1) |"
2240 LPRINT" | | | |"
2250 LPRINT"IN--R-- --R-- --AMP(+1)-- - * * * --R-- --R-- --R-- --AMP(+1)-- OUT"
2260 LPRINT" | | |"
2270 LPRINT" C2 C(n-2) Cn"
2280 LPRINT" | | |"
2290 LPRINT" GND GND GND"
2292 LPRINT" n/2 TWO POLE SECTIONS THREE POLE SECTION"
2300 LPRINT CHR$(12)
2400 CHAIN"FILTMENU"
2995 REM BUTTER.BAS
3000 END
(
geocities.com/russlk)