Category : Science and Education
Archive   : FILTDES.ZIP
Filename : RESRAT.BAS

 
Output of file : RESRAT.BAS contained in archive : FILTDES.ZIP
10 REM RESISTOR SELECTION PROGRAM RESRAT.BAS
20 PRINT "This program will find the two 5% OR 1% tolerance resistor"
30 PRINT "values which most closely provide a required ratio."
40 PRINT "The minimum values given will range from 10 to 91 for"
50 PRINT "5% and 10 to 97.6 for 1%."
60 PRINT "ACTUAL RESISTANCE VALUES ARE DETERMINED BY THE USER!"
65 GOTO 75
70 CLEAR
75 INPUT "What resistor tolerance would you like, 1% or 5%(Enter 1 or 5)";TOL
80 IF TOL=5 THEN NV=25 :GOTO 110
90 IF TOL=1 THEN NV=97 :GOTO 110
100 GOTO 75
110 DIM D(100)
120 DIM F(100,8)
130 FOR I=1 TO 25
140 READ D(I)
150 NEXT I
170 DATA 10,11,12,13,15,16,18,20, 22,24,27,30
180 DATA 33,36,39,43,47,51,56,62,68,75,82,91,100
190 IF TOL=5 GOTO 320
195 FOR I=1 TO NV
196 READ D(I)
197 NEXT I
200 DATA 10,10.2,10.5,10.7,11,11.3,11.5,11.8,12.1
210 DATA 12.4,12.7,13,13.3,13.7,14,14.3,14.7,15
220 DATA 15.4,15.8,16.2,16.5,16.9,17.4,17.8,18.2
230 DATA 18.7,19.1,19.6,20,20.5,21,21.5,22.1,22.6
240 DATA 23.2,23.7,24.3,24.9,25.5,26.1,26.7,27.4
250 DATA 28,28.7,29.4,30.1,30.9,31.6,32.4,33.2,34
260 DATA 34.8,35.7,36.5,37.4,38.3,39.2,40.2,41.2
270 DATA 42.2,43.2,44.2,45.2,46.4,47.5,48.7,49.9
280 DATA 51.1,52.3,53.6,54.9,56.2,57.6,59,60.4,61.9
290 DATA 63.4,64.9,66.5,68.1,69.8,71.5,73.2,75,76.8
300 DATA 78.7,80.6,82.5,84.5,86.6,88.7,90.9,93.1
310 DATA 95.3,97.6,100
320 INPUT "Is one resistor value known (Y/N)";A$
330 IF A$="N" GOTO 360
340 IF A$<>"Y" GOTO 320
350 GOTO 1360
360 INPUT "Required ratio is:";X :K=X
370 IF X<=0 THEN PRINT "WHO ARE YOU TRYING TO KID???":GOTO 360
380 IF X<1 THEN X=1/X
390 S=0
400 IF X>=1 AND X<10 GOTO 440
410 X=X/10
420 S=S+1
430 GOTO 400
440 IF X=1 THEN PRINT"Any resistor twice or with a decade value will do!!!":GOTO 70
450 IF S=0 THEN W=1: GOTO 470
460 GOSUB 1310
470 FOR I=1 TO NV-1
480 Q=0
490 R2=D(I)
500 R1=X*R2
510 IF R1>=10 AND R1<=100 GOTO 550
520 R1=R1/10
530 Q=Q+1
540 GOTO 510
550 T=1
560 RL=D(T)
570 IF R1<=RL GOTO 610
580 T=T+1
590 IF T=NV+1 GOTO 1240
600 GOTO 560
610 RH=RL: RL=D(T-1)
620 IF Q=0 THEN V=1: GOTO 640
630 GOSUB 1260
640 IF K<1 THEN XL=R2/(W*V*RH):XH=R2/(W*V*RL): GOTO 660
650 XL=(W*V*RL)/R2: XH=(W*V*RH)/R2
660 EL=K-XL: EH=XH-K
670 IF K<1 THEN F(I,1)=RH*V:F(I,2)=EL:F(I,3)=RL*V:F(I,4)=EH: GOTO 690
680 F(I,1)=RL*V:F(I,2)=EL:F(I,3)=RH*V:F(I,4)=EH
690 NEXT I
700 A=0:B=0
710 FOR I=1 TO 3
720 F(I,5)=1000:F(I,6)=1000
730 F(I,7)=0: F(I,8)=0
740 NEXT I
750 FOR I=1 TO NV-1
760 A=F(I,2):B=F(I,4)
770 C=1
780 IF A 790 C=C+1
800 IF C=4 GOTO 820
810 GOTO 780
820 C=1
830 IF B 840 C=C+1
850 IF C=4 GOTO 960
860 GOTO 830
870 REM
880 F((C+2),5)=F((C+1),5):F((C+2),7)=F((C+1),7)
890 F((C+1),5)=F(C,5):F((C+1),7)=F(C,7)
900 F(C,5)=A:F(C,7)=I
910 GOTO 820
920 REM
930 F((C+2),6)=F((C+1),6):F((C+2),8)=F((C+1),8)
940 F((C+1),6)=F(C,6):F((C+1),8)=F(C,8)
950 F(C,6)=B: F(C,8)=I
960 NEXT I
970 PRINT "If the ratio is set by R1/R2"
980 PRINT "The three best choices for the smallest negative and"
990 PRINT "positive errors are:"
1000 PRINT "R1" TAB(10) "R2" TAB(20) "PERCENT ERROR"
1010 PRINT "--" TAB(10) "--" TAB(20) "-------------"
1020 FOR C=1 TO 3
1030 A=F(C,7)
1040 IF K<1 THEN R2=W*F(A,1):R1=D(A):GOTO 1060
1050 R2=D(A):R1=W*F(A,1)
1060 PEL=((F(A,2)*-1)/K)*100
1070 PRINT R1 TAB(10) R2 TAB(24);
1080 PRINT USING "##.###";PEL;:PRINT "%"
1090 NEXT C
1100 FOR C=1 TO 3
1110 A=F(C,8)
1120 IF K<1 THEN R2=W*F(A,3):R1=D(A):GOTO 1140
1130 R2=D(A):R1=W*F(A,3)
1140 PEH=(F(A,4)/K)*100
1150 PRINT R1 TAB( 10) R2 TAB( 24);
1160 PRINT USING "##.###";PEH;:PRINT "%"
1170 NEXT C
1180 FOR I=1 TO NV-1
1190 FOR R=1 TO 8
1200 F(I,R)=0
1210 NEXT R
1220 NEXT I
1230 GOTO 70
1240 F(I,2)=1000:F(I,4)=1000
1250 GOTO 690
1260 Z=Q:V=1
1270 FOR Z=Z TO 1 STEP-1
1280 V=V*10
1290 NEXT Z
1300 RETURN
1310 Z=S:W=1
1320 FOR Z=Z TO 1 STEP-1
1330 W=W*10
1340 NEXT Z
1350 RETURN
1360 INPUT "Is known value in numerator or denominator (N/D)";A$
1370 IF A$="N" THEN B=1: GOTO 1400
1380 IF A$<>"D" GOTO 1360
1390 B=2
1400 INPUT "Enter the known R value (DON'T ABBREVIATE must be>=10)";R1
1410 INPUT "What is the required ratio";K
1420 IF K<1 THEN C=1
1430 IF K>1 THEN C=2
1440 IF K<=0 THEN PRINT "WHO ARE YOU TRYING TO KID!?!":GOTO 1410
1450 V=1:W=1:M=1
1460 IF R1>=10 AND R1<100 GOTO 1500
1470 R1=R1/10
1480 M=M*10
1490 GOTO 1460
1500 IF B=1 AND C=1 GOTO 1540
1510 IF B=1 AND C=2 GOTO 1580
1520 IF B=2 AND C=1 GOTO 1590
1530 X=K: GOTO 1550
1540 X=1/K
1550 IF X>=1 AND X<10 GOTO 1630
1560 X=X/10: W=W*10
1570 GOTO 1550
1580 X=1/K: GOTO 1600
1590 X=K
1600 IF X>=1 AND X<10 GOTO 1630
1610 X=X*10: W=W/10
1620 GOTO 1600
1630 V=1
1640 IF X=1 THEN RH=R1:RL=R1: GOTO 1780
1650 RX=R1*X
1660 IF RX>=10 AND RX<100 GOTO 1700
1670 RX=RX/10
1680 V=V*10
1690 GOTO 1660
1700 T=1
1710 RL=D(T)
1720 IF RX<=RL GOTO 1760
1730 T=T+1
1740 IF T=NV+1 GOTO 2050
1750 GOTO 1710
1760 RH=RL
1770 RL=D(T-1)
1780 RH=RH*V*W: RL=RL*V*W
1790 IF B=1 AND C=1 THEN XL=R1/RH: XH=R1/RL: GOTO 1830
1800 IF B=1 AND C=2 THEN XL=R1/RH: XH=R1/RL: GOTO 1830
1810 IF B=2 AND C=1 THEN XL=RL/R1: XH=RH/R1: GOTO 1830
1820 XL=RL/R1: XH=RH/R1
1830 EH=XH-K: EL=XL-K
1840 PEL=(EL/K)*100: PEH=(EH/K)*100
1850 IF B=1 AND C=1 THEN RW=R1*M:RX=RW:RY=RH*M:RZ=RL*M:GOTO 1890
1860 IF B=1 AND C=2 THEN RW=R1*M:RX=RW:RY=RH*M:RZ=RL*M:GOTO 1890
1870 IF B=2 AND C=1 THEN RW=RL*M:RX=RH*M:RY=R1*M:RZ=RY:GOTO 1890
1880 RW=RL*M:RX=RH*M:RY=R1*M:RZ=RY
1890 PRINT "If the ratio is set by R1/R2"
1900 PRINT "The best choices are:"
1910 PRINT "R1" TAB(10) "R2" TAB(20) "PERCENT ERROR"
1920 PRINT "--" TAB(10) "--" TAB(20) "-------------"
1930 PRINT RW TAB(10) RY TAB(24);
1940 PRINT USING "##.###";PEL;:PRINT "%"
1950 PRINT RX TAB(10) RZ TAB(24);
1960 PRINT USING "##.###";PEH;:PRINT "%"
1970 GOTO 70
1980 FOR I= 1 TO NV-1
1990 FOR J=1 TO 8
2000 PRINT F(I,J);
2010 NEXT J
2020 PRINT
2030 NEXT I
2040 GOTO 750
2050 PRINT "DIDN'T FIND A VALUE!"
2060 GOTO 70

2060 GOTO 70

  3 Responses to “Category : Science and Education
Archive   : FILTDES.ZIP
Filename : RESRAT.BAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. 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/