Category : Science and Education
Archive   : FILTDES.ZIP
Filename : FILTRP.BAS
20 REM LINKED FROM SYNTHESIS PROGRAM FILSYP.BAS
30 F0=1:C$="N"
40 PRINT "NOW RUNNING THE FILTER TRANSFORMATION PROGRAM*********
50 OPEN "I",1,"PROTO"
60 INPUT #1,R,G,HCP,F1,F2,A1,Z
70 REGY=R
80 IF R=1 GOTO 360
90 IF HCP=1 THEN HC=1:C$="Y"
100 IF Z=1 THEN INPUT #1,N:GOTO 120
110 INPUT #1,A2
120 IF R=2 THEN INPUT #1,FC,FS:GOTO 140
130 INPUT #1,BW,SW,FCNTR
140 IF EOF(1) THEN CLOSE #1
150 IF R=2 THEN G$="H":R$="HIGHPASS"
160 IF R=3 THEN G$="B":R$="BANDPASS"
170 IF R=4 THEN G$="N":R$="NOTCH"
180 H$="F"
190 IF G=1 THEN T$="BUTTERWORTH"
200 IF G=2 THEN T$="CHEBYSHEV"
210 IF G=3 THEN T$="ELLIPTIC"
220 GOSUB 1230
230 F9=1
240 N9=1
250 IF G$="H" THEN GOSUB 1370 ELSE 370
260 PRINT:PRINT "DESIGN COMPLETE..."
270 PRINT" PRESS T - TRY ANOTHER FILTER"
280 PRINT" R - CALCULATE GAIN AND PHASE RESPONSE OF THIS FILTER"
290 PRINT" E - END THIS SESSION"
300 INPUT V$
310 IF V$="T" OR V$="t" THEN RUN "FILDES.BAS"
320 IF V$="R" OR V$="r" THEN RUN "FILPLT.BAS"
330 IF V$="E" OR V$="e" THEN SYSTEM
340 GOTO 270
350 REM LOWPASS FILTER
360 PRINT:PRINT "LOWPASS FILTERS DON'T NEED TRANSFORMING!!!":GOTO 260
370 IF (G$="N") AND (N1<>(N0+N2)) THEN N3=2*(N0-N1)+N2
380 W0=FCNTR:B=BW
390 B0=B
400 IF N0=0 THEN 470
410 FOR K=1 TO N0
420 S=F(K)/(2*Q(K)):W=SQR(F(K)^2-S^2)
430 GOSUB 1090
440 FF(2*K-1)=W1:QQ(2*K-1)=Q1
450 FF(2*K)=W2:QQ(2*K)=Q2
460 NEXT K
470 IF N2=0 THEN 530
480 FOR K=1 TO N2
490 W=0:S=RR(K)
500 GOSUB 1180
510 FF(2*N0+K)=W2:QQ(2*N0+K)=Q2
520 NEXT K
530 IF N1=0 THEN 590
540 FOR K=1 TO N1
550 S=0 :W=Z(K)
560 GOSUB 1090
570 ZZ(2*K-1)=I1:ZZ(2*K)=I2
580 NEXT K
590 FOR I=1 TO 5:PRINT
600 IF HC=1 THEN LPRINT
610 NEXT I
620 PRINT " TRANSFORMED POLE / ZERO LOCATIONS "
630 IF HC=1 THEN LPRINT " TRANSFORMED POLE / ZERO LOCATIONS "
640 PRINT" For this "T$" "R$" filter:"
650 IF HC=1 THEN LPRINT" For this "T$" "R$" filter:"
660 PRINT:PRINT "FILTER CENTER FREQUENCY ";W0*F9,"BANDWIDTH ";B0*F9
670 IF HC=1 THEN LPRINT
680 IF HC=1 THEN LPRINT "FILTER CENTER FREQUENCY ";W0*F9,"BANDWIDTH ";B0*F9
690 PRINT: PRINT "RESONANT FREQUENCIES:":PRINT: PRINT "FREQUENCY"," Q":PRINT
700 IF HC<>1 THEN 740
710 LPRINT
720 LPRINT "RESONANT FREQUENCIES:":LPRINT
730 LPRINT "FREQUENCY"," Q":LPRINT:LPRINT
740 OPEN "O",3,"PLTDATA"
750 PRINT #3,REGY,G,2*N0+N2+2*N1+N3
760 FOR J1=1 TO 2*N0+N2:PRINT FF(J1)*F9,QQ(J1)
770 IF HC=1 THEN LPRINT FF(J1)*F9,QQ(J1)
780 PRINT #3,F9*FF(J1),QQ(J1)
790 NEXT J1
800 GOTO 910
810 OPEN "O",1,"TRNP"
820 PRINT #1,W0*F9,2*N0+N2,2*N0+N2,0
830 IF N2=0 THEN 850
840 IF N3=0 THEN FOR I=1 TO N2: PRINT #1,0,1,0:NEXT I
850 IF N1<>0 THEN FOR I=1 TO 2* N1:PRINT #1,1,0,ZZ(I)*F9:NEXT I
860 IF N3<>0 THEN FOR I=1 TO N3:PRINT #1,1,0,W0*F9:NEXT I
870 IF N1=0 AND N3=0 THEN FOR I=1 TO N0*2:PRINT #1,0,1,0:NEXT I
880 IF N0=0 AND N2=0 THEN 900
890 FOR I=1 TO 2*N0+N2:PRINT #1,FF(I)*F9,QQ(I):NEXT I
900 CLOSE 1
910 PRINT
920 IF N1+N3 <> 0 THEN PRINT "ZEROS (or NOTCHES)" ELSE 1060
930 IF HC=1 THEN LPRINT: LPRINT "ZEROS (or NOTCHES)"
940 PRINT:IF HC=1 THEN LPRINT
950 IF N1=0 THEN 1000
960 FOR I=1 TO 2*N1:PRINT ZZ(I)*F9
970 IF HC=1 THEN LPRINT ZZ(I)*F9
980 PRINT #3,ZZ(I)*F9,-1
990 NEXT I
1000 IF N3=0 THEN 1050
1010 FOR I=1 TO N3:PRINT W0*F9
1020 IF HC=1 THEN LPRINT W0*F9
1030 PRINT #3,W0*F9,-2
1040 NEXT I
1050 CLOSE 3
1060 PRINT :PRINT:IF HC=1 THEN LPRINT :IF HC=1 THEN LPRINT
1070 REM IF C$="Y" THEN GOSUB 1560
1080 GOTO 260
1090 C0=W0^2-(B0^2)*(S^2-W^2)/4:D0=S*W*(B0^2)/2
1100 A0=SQR((C0+SQR(C0^2+D0^2))/2)
1110 B=D0/(2*A0)
1120 R2=B0*S/2+B:I1=A0-W*B0/2
1130 R1=B0*S/2-B:I2=A0+W*B0/2
1140 W1=SQR(R1^2+I1^2):W2=SQR(R2^2+I2^2)
1150 IF R1+R2 =0 THEN 1170
1160 Q1=W1/(2*R1):Q2=W2/(2*R2)
1170 RETURN
1180 R=B0*S/2
1190 II=SQR(W0^2-R^2)
1200 W2=SQR(R^2+II^2)
1210 Q2=W2/(2*R)
1220 RETURN
1230 OPEN "I",1,"IDATA"
1240 INPUT #1,F0,N1,N0,N2
1250 N3=0
1260 IF N2<>0 THEN FOR I=1 TO N2:INPUT #1,RR(I):NEXT I
1270 IF G$="N" AND N2 <> 0 THEN FOR I=1 TO N2:RR(I)=1/RR(I):NEXT I
1280 IF N1=0 THEN 1320
1290 FOR I=1 TO N1:INPUT #1,A(I),B(I),Z(I)
1300 IF G$="N" THEN Z(I)=1/Z(I)
1310 NEXT I
1320 FOR I=1 TO N0:INPUT #1,F(I),Q(I)
1330 IF G$="N" THEN F(I)=1/F(I)
1340 NEXT I
1350 CLOSE 1
1360 RETURN
1370 OPEN "O",1,"PLTDATA"
1380 PRINT #1,2,G,N0+N1+N2
1390 X(1)=FC
1400 PRINT:PRINT:PRINT: PRINT " TRANSFORMED POLE/ZERO LOCATIONS"
1410 IF HC<>1 THEN 1440
1420 LPRINT:LPRINT:LPRINT: LPRINT " TRANSFORMED POLE/ZERO LOCATIONS"
1430 LPRINT:LPRINT " For this "T$" "R$" filter:":LPRINT
1440 PRINT:PRINT " For this "T$" "R$" filter:":PRINT
1450 IF N2<>0 THEN FOR I=1 TO N2:RR(I)=(F0/RR(I))*F9:NEXT I
1460 IF N1<>0 THEN FOR I=1 TO N1:Z(I)=F0/Z(I)*F9:NEXT I
1470 IF N0<>0 THEN FOR I=1 TO N0:F(I)=F0/F(I)*F9:NEXT I
1480 K=1
1490 PRINT:PRINT "RESONANT FREQUENCIES:":PRINT
1500 PRINT " F"," Q"
1510 IF HC<>1 THEN 1540
1520 LPRINT:LPRINT "RESONANT FREQUENCIES:":LPRINT
1530 LPRINT " F"," Q"
1540 IF N0<>0 THEN 1545 ELSE GOTO 1550
1545 FOR I=1 TO N0:PRINT F(I)*X(K),Q(I):PRINT #1,F(I)*X(K),Q(I):NEXT I
1550 IF N2=0 GOTO 1580
1560 PRINT:PRINT "REAL POLE(S):"
1570 FOR I=1 TO N2:PRINT RR(I)*X(K):PRINT #1,RR(I)*X(K),0:NEXT I
1580 PRINT:PRINT " Z"
1590 IF N1<>0 THEN FOR I=1 TO N1:PRINT Z(I)*X(K):PRINT #1,Z(I)*X(K),-1:NEXT I
1600 CLOSE 1
1610 OPEN "O",1,"TRNP"
1620 IF N1<>0 THEN PRINT #1,X(K),N1+N2,N0,N2 ELSE PRINT #1,X(K),N0+N2,N0,N2
1630 IF N2<>0 THEN FOR I=1 TO N2:PRINT #1,RR(I)*X(K):NEXT I
1640 IF N1<>0 THEN FOR I=1 TO N1:PRINT #1,1,0,Z(I)*X(K):NEXT I
1650 IF N1=0 THEN FOR I=1 TO N0:PRINT #1,1,0,0:NEXT I
1660 IF N2<>0 THEN FOR I=1 TO N2:PRINT #1,0,1,0:NEXT I
1670 IF N0<>0 THEN FOR I=1 TO N0:PRINT #1,F(I)*X(K),Q(I):NEXT I
1680 IF HC<>1 THEN 1780
1690 IF N0<>0 THEN FOR I=1 TO N0:LPRINT F(I)*X(K),Q(I):NEXT I
1700 IF N2=0 GOTO 1730
1710 LPRINT:LPRINT "REAL POLE(S):"
1720 FOR I=1 TO N2:LPRINT RR(I)*X(K):NEXT I
1730 IF N1<>0 GOTO 1760
1750 GOTO 1780
1760 LPRINT:LPRINT " ZEROS"
1770 FOR I=1 TO N1:LPRINT Z(I)*X(K):NEXT I
1780 REM IF C$="Y" THEN GOSUB 1700
1790 CLOSE 1
1800 RETURN
1810 OPEN "O",2,"LPT:"
1820 PRINT #2," TRANSFORMATED POLE/ZERO LOCATIONS"
1830 PRINT #2," FILTER #";J
1840 PRINT #2,:PRINT #2,"POLE LOCATIONS":PRINT #2,"FREQUENCY"," Q"
1850 FOR J1=1 TO 2*N0+N2:PRINT #2,FF(J1)*F9,QQ(J1):NEXT J1
1860 IF N1+N3<>0 THEN PRINT #2," JW AXIS ZERO PAIRS" ELSE 1900
1870 PRINT #2,:FOR I=1 TO 2*N1:PRINT #2,ZZ(I)*F9:NEXT I
1880 IF N3=0 THEN 1900
1890 FOR I=1 TO N3 :PRINT #2,W0*F9:NEXT I
1900 IF N4+N5<>0 THEN PRINT #2,"COMPLEX ZEROS"," Q" ELSE 1930
1910 FOR I=1 TO 2*N1+1:PRINT #2,ZZ(I)*F9,VV(I):NEXT I
1920 PRINT #2,
1930 CLOSE 2
1940 RETURN
1950 OPEN "O",2,"LPT:"
1960 PRINT #2,:PRINT #2," TRANSFORMED POLE/ZERO LOCATIONS"
1970 PRINT #2,:PRINT #2," HIGHPASS FILTER"
1980 PRINT #2,:PRINT #2," FILTER ";K
1990 PRINT #2,:PRINT #2," F"," Q"
2000 IF N0<>0 THEN FOR I=1 TO N0:PRINT #2,F(I)*X(K),Q(I):NEXT I
2010 IF N2<>0 THEN FOR I=1 TO N2:PRINT #2,RR(I)*X(K):NEXT I
2020 PRINT #2,:PRINT #2," Z"
2030 IF N1<>0 THEN FOR I=1 TO N1:PRINT #2,Z(I)*X(K):NEXT I
2040 CLOSE 2
2050 RETURN
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/