home *** CD-ROM | disk | FTP | other *** search
- 10 REM FILTER TRANSFORMATION PROGRAM 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.EXE"
- 320 IF V$="R" OR V$="r" THEN RUN "FILPLT.EXE"
- 330 IF V$="E" OR V$="e" THEN SYSTEM
- 340 GOTO 270
- 350 RUN "FILDES.EXE"
- 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: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 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