Ballistics ProgramIn Microsoft BASIC This program runs under Microsoft BASIC and can be used to calculate various features of cartridge performance, such as bullet drop, recoil force and the effect of a cross-wind. It is offered by Marple Rifle and Pistol Club on the basis of you using it at your own risk: see Ballistics page for more detail. It is essential that you input a value for all data points, if you leave one out, for example the Ballistic Coefficient, the program will loop and not run properly. There are Batch Files here to start the program under GW BASIC and in addition the more up-to date QBASIC. It is thought that the program will run under other versions of BASIC, but this has not been tested. 10 CLS 20 KEY OFF 30 SCREEN 9 40 COLOR 11, 12 50 PRINT " Ballistics": PRINT 60 PRINT " by Mike Williams" 70 PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT " Press any key to start" 80 FOR J=1 TO 200 STEP 30 90 CIRCLE (320, 175), J 100 NEXT J 110 WHILE INKEY$ = "" 120 WEND 130 REM *** THIS PROGRAM HAS SEVERAL MODULES, EACH DEALING WITH A SEPARATE 140 REM *** SUBJECT ... COPYRIGHT MICHAEL WILLIAMS ... DECEMBER 1993 150 GOTO 170 160 COLOR TEX%, BAK% 170 CLS: PRINT: PRINT: PRINT: PRINT: PRINT: PRINT: PRINT 180 PRINT " Ballistics , Recoil and Loading Data" 190 PRINT: PRINT " A Program for their evaluation" 200 PRINT: PRINT " By Michael Williams ... Ver 1 ... Dec 1993": PRINT: 210 PRINT " Enter ... (B)allistics" 220 PRINT " (R)ecoil" 230 PRINT " (L)oading Data" 240 PRINT " (S)et Colours" 250 PRINT " (E)xit": PRINT 260 INPUT " Enter your choice ",D$ 270 IF D$ = "B" THEN GOTO 330 280 IF D$ = "R" THEN GOTO 3570 290 IF D$ = "L" THEN GOTO 4370 300 IF D$ = "S" THEN GOTO 4430 310 IF D$ = "E" THEN SYSTEM 320 IF D$<>"B" AND R$<>"R" AND L$<>"L" AND D$<>"S" AND D$<> "E" THEN GOTO 170 330 CLS: PRINT TAB(22);"*** Trajectories for G1 Bullets ***":PRINT 340 REM ** WRITTEN ORIGINALLY BY WILLIAM C DAVIS IN 1984 350 PRINT TAB(19);"Modified for UK use by Mike Williams 1993": PRINT 360 PRINT TAB(17);"This program offers a choice between Imperial": PRINT 370 PRINT TAB(21);" and Metric units for range distance": PRINT: PRINT 380 PRINT " What atmospheric / altitude conditions do you want to use ?": PRINT 390 PRINT " 1 = Standard ICAO (59 Deg-F at sea level)": PRINT 400 PRINT " 2 = Another temperature and / or altitude": PRINT 410 INPUT " ";QA 420 IF QA<>1 AND QA<>2 THEN GOTO 330 430 IF QA=2 THEN GOSUB 3470 ELSE RO=1: AL=0: TF=59: A=1 440 INPUT " Height of sight above bore centre (in inches) .. ";H 450 INPUT " Cartridge identification ....................... ";C$ 460 INPUT " Bullet weight in (grains) ...................... ";G 470 INPUT " Ballistic Coefficient (C1) ..................... ";C1 480 REM ** IN THE LINE BELOW THE TERM VA=V/A IS AN ADJUSTMENT FOR SONIC VELOCITY 490 INPUT " Muzzle velocity (in feet per second) ........... ";V: VA=V/A: REM ** ADJUST FOR MACH RATIO 500 X=0: GOSUB 590: REM ** INITIALISE RANGE , FIND DATA FOR MUZZLE VELOCITY 510 PRINT " What is your choice ?" 520 PRINT " 1 = Range table" 530 INPUT " 2 = Bullet path from sight line ";QB 540 IF QB <> 1 AND QB <> 2 THEN PRINT " Try again": GOTO 510 550 IF QB = 1 THEN GOTO 780 560 IF QB = 2 THEN GOTO 1550 570 PRINT 580 GOTO 510 590 REM ** FIND SVA TVA SUA TRAJECTORY ELEMENTS 600 GOSUB 2740: REM ** FIND COEFFICIENTS FOR V/A 610 SVA=AAS+BS*(VA-VBA)+CS*(VA-VBA)^2 620 TVA=AT+BT*(VA-VBA)+CT*(VA-VBA)^2 630 SUA=SVA+RO*X/C1 640 GOSUB 2990: REM ** FIND COEFFICIENT FOR SUA 650 UA=VBA+(-BS-SQR(BS^2-4*CS*(AAS-SUA)))/(2*CS): U=UA*A 660 EN=U^2*G/450400!: REM ** BULLET ENERGY CALCULATION 670 F=14.0069+6.59285*((U/V)-.65)-1.94051*((U/V)-.65)^2 680 TUA=AT+BT*(UA-VBA)+CT*(UA-VBA)^2 690 T=(C1/(RO*A))*(TUA-TVA) 700 D=12*F*T^2: REM ** DROP 710 YM=48.6*T^2: REM ** MAXIMUM ORDINATE 720 HM=YM-.4*H: REM ** MAX HEIGHT ABOVE SIGHT LINE 730 DF=176*(T-X/V): REM ** WIND DEFLETION FOR 10 MPH CROSS-COMPONENT 740 MM=2*(EN/U): REM ** MOMENTUM IN LB-SEC 750 IF X=0 THEN E=0 ELSE E=(D+H)/(X/300): REM ** ELEVATION MOA 760 RETURN 770 REM ** RANGE TABLE 780 INPUT " Choose range distance measurements ... 1=Yards ... 2=Metres ";QM 790 IF QM <> 1 AND QM <> 2 THEN PRINT " Try again ": GOTO 780 800 IF QM=2 THEN INPUT " First range for the table (Metres) ";FM: FX=3.2808*FM 810 IF QM=2 THEN INPUT " Last range for the table (Metres) ";LM: LX=3.2808*LM 820 IF QM=2 THEN INPUT " Range increment (Metres) ";IM: IX=3.2808*IM 830 IF QM=2 AND IM >(LM-FM) THEN PRINT " Try again !! ": GOTO 800 840 IF QM=2 THEN GOTO 910 850 INPUT " First range for the table (Yards) ";FR: FX=3*FR 860 INPUT " Last range for the table (Yards) ";LR: LX=3*LR 870 INPUT " Range increment (Yards) ";IR: IX=3*IR 880 IF IR >(LR-FR) THEN PRINT " Try again !!! ": GOTO 850 890 PRINT : PRINT " One moment please ... computing table " 900 Z=INT((LR-FR)/IR): REM ** DIMENSION FOR ARRAY 910 IF QM=2 THEN Z=INT((LM-FM)/IM+5): REM ** DIMENSION FOR ARRAY 920 DIM X(Z): DIM E(Z): DIM V(Z): DIM U(Z): DIM SV(Z): DIM SU(Z): DIM TV(Z): DIM TU(Z): DIM EN(Z): DIM F(Z): DIM T(Z): DIM D(Z): DIM YM(Z): DIM HM(Z): DIM DF(Z) : DIM MM(Z): REM ** DIMENSION ARRAYS FOR RANGE TABLE 930 X=FX: N=0: REM ** INITIALISE X AND N 940 GOSUB 590: REM ** FIND DATA FOR Nth RANGE 950 X(N)=X: V(N)=V: U(N)=U: EN(N)=EN: T(N)=T: D(N)=D: YM(N)=YM: HM(N)=HM: DF(N)=DF: MM(N)=MM: E(N)=E: REM ** SAVE VALUES THIS PASS 960 IF X(N)=0 THEN YM(N)=0: HM(N)=-H 970 N=N+1: X=FX+N*IX: REM ** INCREMENT N AND X 980 IF X>(LX+1) THEN GOTO 1000: REM ** BREAKOUT CONDITION 990 GOTO 940: REM ** NEXT LOOP 1000 NF=N: REM ** END VALUE ON COUNTER 1010 CLS 1020 IF QA=1 THEN PRINT " Cartridge... ";C$;TAB(48);"Standard ICAO ": GOTO 1050 1030 PRINT " Cartridge identification ";C$ 1040 PRINT " Altitude (Ft)........... ";AL;TAB(47);" Temperature (Deg F)..... ";TF 1050 PRINT " Bullet weight (Grns).... ";G;TAB(47);" Sight above bore (in)... ";H 1060 PRINT " Muzzle velocity (fps)... ";V;TAB(47);" Ballistic Co. (C1)...... ";C1:PRINT 1070 PRINT " Range";TAB(9);"Remain";TAB(17);"Remain";TAB(25);"Mom-";TAB(33);"Bullet";TAB(41);"Elev-"; TAB(49);"Time of";TAB(57);"Max.";TAB(65);"Max.";TAB(73);"10 mph" 1080 PRINT " in";TAB(9);"veloc.";TAB(17);"energy";TAB(25);"entum";TAB(33);"drop";TAB(41);"ation";TAB(49); "flight";TAB(57);"ord";TAB(65);"high";TAB(73);"wind" 1090 IF QM=1 THEN PRINT " Yards"; 1100 IF QM=2 THEN PRINT " Metres"; 1110 PRINT TAB(9);"fps";TAB(17);"ft-lbs";TAB(25);"lb-sec";TAB(33);"inches";TAB(41);"moa";TAB(49);"in sec"; TAB(57);"inches";TAB(65);"inches";TAB(73);"inches" 1120 FOR N=0 TO (NF-1) 1130 IF QM=1 THEN PRINT USING"####";X(N)/3; 1140 IF QM=2 THEN PRINT USING"####";X(N)/3.28084; 1150 PRINT TAB(9);:PRINT USING"####";U(N); 1160 PRINT TAB(17);:PRINT USING"####";EN(N); 1170 PRINT TAB(25);:PRINT USING"#.##";MM(N); 1180 PRINT TAB(33);:PRINT USING"###.#";D(N); 1190 PRINT TAB(41);:PRINT USING"##.#";E(N); 1200 PRINT TAB(49);:PRINT USING"#.###";T(N); 1210 PRINT TAB(57);:PRINT USING"###.#";YM(N); 1220 PRINT TAB(65);:PRINT USING"###.#";HM(N); 1230 PRINT TAB(72);:PRINT USING"###.##";DF(N) 1240 NEXT N 1250 PRINT 1260 INPUT " Print table (1=Yes 2=No) ";QP 1270 IF QP <> 1 THEN CLS: GOTO 2490 1280 ON ERROR GOTO 4270 1290 IF QA=1 THEN LPRINT "Cartridge............... ";C$;TAB(48);"Standard ICAO": GOTO 1320 1300 LPRINT "Cartridge .............. ";C$ 1310 LPRINT "Altitude (Ft)... ";AL;TAB(47);" Temperature (Deg F)... ";TF 1320 LPRINT "Bullet weight (Grns).... ";G;TAB(47);" Sight above bore (in)... ";H 1330 LPRINT "Muzzle velocity (fps)... ";V;TAB(47);" Ballistic Co. (C1)...... ";C1:PRINT 1340 LPRINT 1350 LPRINT "Range";TAB(8);"Remain";TAB(16);"Remain";TAB(24);"Mom-";TAB(32);"Drop";TAB(40); "Elev-";TAB(48);"Time of";TAB(56);"Max.";TAB(64);"Max.";TAB(72);"10 mph" 1360 LPRINT " in";TAB(8);"veloc.";TAB(16);"energy";TAB(24);"entum";TAB(32);" in";TAB(40);"ation";TAB(48); "flight";TAB(56);"ord";TAB(64);"high";TAB(72);"wind" 1370 IF QM=1 THEN LPRINT "Yards"; 1380 IF QM=2 THEN LPRINT "Metres"; 1390 LPRINT TAB(8);"fps";TAB(16);"ft-lbs";TAB(24);"lb-sec";TAB(32);"inches";TAB(40);"moa";TAB(48);"in sec"; TAB(56);"inches";TAB(64);"inches";TAB(72);"inches" 1400 FOR N=0 TO (NF-1) 1410 LPRINT 1420 IF QM=1 THEN LPRINT USING"####";X(N)/3; 1430 IF QM=2 THEN LPRINT USING"####";X(N)/3.28084; 1440 LPRINT TAB(8);:LPRINT USING"####";U(N); 1450 LPRINT TAB(16);:LPRINT USING"####";EN(N); 1460 LPRINT TAB(24);:LPRINT USING"#.##";MM(N); 1470 LPRINT TAB(32);:LPRINT USING"###.#";D(N); 1480 LPRINT TAB(40);:LPRINT USING"##.#";E(N); 1490 LPRINT TAB(48);:LPRINT USING"#.###";T(N); 1500 LPRINT TAB(56);:LPRINT USING"###.#";YM(N); 1510 LPRINT TAB(64);:LPRINT USING"###.#";HM(N); 1520 LPRINT TAB(72);:LPRINT USING"###.##";DF(N) 1530 NEXT N 1540 LPRINT: CLS: GOTO 2490 1550 REM ** ROUTINE FOR BULLET PATH FROM SIGHT LINE ** 1560 INPUT " Choose... (1=Yards or 2=Metres) ";QM 1570 IF QM<>1 AND QM<>2 THEN PRINT "Try again": GOTO 1560 1580 IF QM=1 THEN INPUT " Your sight-in range (Yards) ";ZR: ZX=3*ZR 1590 IF QM=2 THEN INPUT " Your sight-in range (Metres) ";ZM: ZX=3.2808*ZM 1600 X=ZX: GOSUB 590: REM ** GET DATA FOR ZEROING RANGE 1610 ZE=E: REM ** TAG ZEROING ELEVATION 1620 PRINT " Choose... " 1630 PRINT " 1=Impact at one range " 1640 INPUT " 2=Tabular data ";QG 1650 IF QG=2 THEN GOTO 1950 1660 IF QM=1 THEN INPUT " What range (Yards) ";NR: NX=3*NR 1670 IF QM=2 THEN INPUT " What range (Metres) ";NM: NX=3.2808*NM 1680 X=NX: GOSUB 590 1690 NE=E: DE=NE-ZE 1700 IF QM=1 THEN DI=-DE*(NX/300): REM ** DIF INCHES AT YARDS RANGE 1710 IF QM=2 THEN DI=-DE*(NX/328.084): REM ** DIF INCHES AT METRIC RANGE 1720 PRINT: PRINT 1730 IF QM=1 THEN PRINT " Sight-in range (Yards)... ";TAB(30);ZR: PRINT 1740 IF QM=2 THEN PRINT " Sight-in range (Metres)... ";TAB(30);ZM: PRINT 1750 IF QM=1 THEN PRINT " Other range (Yards)... ";TAB(30);NR: PRINT 1760 IF QM=2 THEN PRINT " Other range (Metres)... ";TAB(30);NM: PRINT 1770 PRINT " Point of impact (inches)... ";TAB(30);: PRINT USING"###.#";DI:PRINT 1780 PRINT " Sight adjustment (moa)... ";TAB(30);: PRINT USING"###.#";DE: PRINT 1790 PRINT 1800 INPUT "Print this (1=Yes 2=No) ";QC 1810 IF QC<>1 THEN GOTO 1870 1820 IF QM=1 THEN LPRINT " Sight-in range (Yards) ";ZR;TAB(30);"Other range (Yards) ";NR: LPRINT 1830 IF QM=2 THEN LPRINT " Sight-in range (Metres) ";ZM;TAB(30);"Other range (Metres) ";NM: LPRINT 1840 LPRINT " Impact point (inches)... ";:LPRINT USING"###.#";DI; 1850 LPRINT TAB(30);"Sight adjust (moa)... ";:LPRINT USING"###.#";DE 1860 LPRINT 1870 PRINT: PRINT " What next ? " 1880 PRINT " 1=Another range " 1890 PRINT " 2=New sight-in range " 1900 INPUT " 3=More choices ";QH 1910 IF QH=1 THEN GOTO 1660 1920 IF QH=2 THEN GOTO 1560 1930 IF QH=3 THEN CLS: GOTO 510 1940 IF QH <> 1 AND QH <> 2 AND QH <> 3 THEN PRINT " Try again ": GOTO 1870 1950 REM ** BULLET-PATH TABLE ** 1960 IF QM=1 THEN INPUT " First range for table (Yards) ";FR: FX=3*FR 1970 IF QM=2 THEN INPUT " First range for table (Metres) ";FM: FX=3.2808*FM 1980 IF QM=1 THEN INPUT " Last range for table (Yards) ";LR: LX=3*LR 1990 IF QM=2 THEN INPUT " Last range for table (Metres) ";LM: LX=3.2808*LM 2000 IF QM=1 THEN INPUT " Range increment (Yards) ";IR: IX=3*IR 2010 IF QM=2 THEN INPUT " Range increment (Metres) ";IM: IX=3.2808*IM 2020 PRINT: PRINT " One moment please ... computing table" 2030 IF QM=1 THEN Z=INT((LR-FR)/IR): REM ** DIM FOR ARRAY IN YARDS 2040 IF QM=2 THEN Z=INT((LM-FM+1)/IM): REM ** DIM FOR ARRAY IN METRES 2050 DIM X(Z):DIM U(Z):DIM E(Z):DIM EN(Z):DIM DE (Z):DIM DI(Z): REM ** DIM ARRAYS FOR BULLET PATH TABLE 2060 X=FX: N=0: REM ** INITIALISE 2070 GOSUB 590: REM ** DATA FOR Nth RANGE 2080 X(N)=X: U(N)=U: E(N)=E: EN(N)=EN: REM ** SAVE VALUES 2090 DE(N)=E-ZE: DI(N)=-(DE(N)*(X/3)/100): REM ** SAVE ELEVATION DIF,IMPACT DIF 2100 IF X(N)=0 THEN DE (N)=0: DI(N)=-H 2110 N=N+1: X=FX+N*IX: REM ** INCREMENT COUNTER,RANGE 2120 IF X>(LX+1) THEN GOTO 2140: REM ** BREAKOUT 2130 GOTO 2070: REM ** NEXT LOOP 2140 NF=N 2150 CLS 2160 PRINT " Range";TAB(10);"Veloc.";TAB(20);"Impact";TAB(30);"Adjust" 2170 IF QM=1 THEN PRINT " Yards";TAB(10);"fps";TAB(20);"inches";TAB(30);"moa" 2180 IF QM=2 THEN PRINT " Metres";TAB(10);"fps";TAB(20);"inches";TAB(30);"moa" 2190 FOR N=0 TO (NF-1) 2200 IF QM=1 THEN PRINT USING"####";X(N)/3; 2210 IF QM=2 THEN PRINT USING"####";X(N)/3.28084; 2220 PRINT TAB(10);: PRINT USING"####";U(N); 2230 PRINT TAB(20);: PRINT USING"###.#";DI(N); 2240 PRINT TAB(30);: PRINT USING"###.#";DE(N) 2250 NEXT N 2260 INPUT " Print this (1=Yes 2=No) ";QC 2270 IF QC<>1 THEN GOTO 2640 2280 ON ERROR GOTO 4270 2290 LPRINT " Cartridge... ";C$ 2300 IF QA=1 AND QM=1 THEN LPRINT TAB(23);"Standard ICAO";TAB(43);"Sight-in range (Yards)... ";ZR: GOTO 2340 2310 IF QA=1 AND QM=2 THEN LPRINT TAB(23);"Standard ICAO";TAB(43);"Sight-in range (Metres)... ";ZM: GOTO 2340 2320 IF QM=1 THEN LPRINT " Altitude (ft)... ";AL;TAB(23);"Temperature (deg-f)... ";TF;TAB(48);"Sight-in range (Yards)... ";ZR 2330 IF QM=2 THEN LPRINT " Altitude (ft)... ";AL;TAB(23);"Temperature (deg-f)... ";TF;TAB(48);"Sight-in range (Metres)... ";ZM 2340 LPRINT " Bullet weight (grs)... ";G;TAB(48);"Sight above bore (in)... ";H 2350 LPRINT " Muzzle velocity (fps)... ";V;TAB(48);"Ballistic coefficient (C1)... ";C1 2360 LPRINT 2370 LPRINT " Range";TAB(10);"Velocity";TAB(20);"Energy";TAB(30);"Impact";TAB(40);"Adjust" 2380 IF QM=1 THEN LPRINT "Yards";TAB(10);"fps";TAB(20);"ft-lbs";TAB(30);"inches";TAB(40);"moa" 2390 IF QM=2 THEN LPRINT "Metres";TAB(10);"fps";TAB(20);"ft-lbs";TAB(30);"inches";TAB(40);"moa" 2400 FOR N=0 TO (NF-1) 2410 IF QM=1 THEN LPRINT USING"####";X(N)/3; 2420 IF QM=2 THEN LPRINT USING"####";X(N)/3.28084; 2430 LPRINT TAB(10);: LPRINT USING"####";U(N); 2440 LPRINT TAB(20);: LPRINT USING"####";EN(N); 2450 LPRINT TAB(30);: LPRINT USING"###.#";DI(N); 2460 LPRINT TAB(40);: LPRINT USING"###.#";DE(N) 2470 NEXT N 2480 CLS: GOTO 2640: REM ** MENU AND ERASE ARRAYS FOR REDIM BULLET-PATH TABLES 2490 REM ** PROGRAM CHOICES ** 2500 PRINT 2510 PRINT " What next ..........................." 2520 PRINT 2530 PRINT " 1=More data , same cartridge and load" 2540 PRINT " 2=Same cartridge and bullet , new velocity" 2550 PRINT " 3=Same cartridge , new bullet" 2560 PRINT " 4=New cartridge" 2570 INPUT " 5=Return to start ";QN 2580 ERASE X,E,V,U,SV,SU,TV,TU,EN,F,T,D,YM,HM,DF,MM: REM ** ERASE ARRAYS TO ALLOW REDIMENSIONING OF VARIABLES IN RANGE TABLE 2590 IF QN=1 GOTO 510 2600 IF QN=2 THEN GOTO 490 2610 IF QN=3 THEN GOTO 460 2620 IF QN=4 THEN GOTO 450 2630 IF QN=5 THEN GOTO 170 2640 PRINT " What next ?": PRINT TAB(5);"1=More data , same cartridge & load": PRINT TAB(5);"2=Same cartridge & bullet , new velocity": PRINT TAB(5);"3=Same cartridge , new bullet": PRINT TAB(5);"4=New cartridge" 2650 PRINT TAB(5);"5=Return to start of program" 2660 INPUT QN 2670 IF QN<>1 AND QN<>2 AND QN<>3 AND QN<>4 AND QN<>5 THEN PRINT " Try again": GOTO 2640 2680 ERASE X,U,E,EN,DE,DI: REM ** ERASE ARRAYS FOR REDIMENSIONING VARIABLES IN BULLET-PATH TABLE 2690 IF QN=1 THEN GOTO 510 2700 IF QN=2 THEN GOTO 490 2710 IF QN=3 THEN GOTO 460 2720 IF QN=4 THEN GOTO 450 2730 IF QN=5 THEN GOTO 170 2740 REM ** FIND COEFFICIENTS FOR S AND T EQUATIONS ** 2750 IF V<300 OR V>4500 THEN PRINT " Velocity is out of range of program." 2760 IF V<300 OR V>4500 THEN PRINT: PRINT " use tables or select a velocity between 300 & 4500 fps" 2770 IF VA>=300 AND VA<400 THEN GOTO 3250 2780 IF VA>=400 AND VA<500 THEN GOTO 3260 2790 IF VA>=500 AND VA<600 THEN GOTO 3270 2800 IF VA>=600 AND VA<700 THEN GOTO 3280 2810 IF VA>=700 AND VA<800 THEN GOTO 3290 2820 IF VA>=800 AND VA<900 THEN GOTO 3300 2830 IF VA>=900 AND VA<1000 THEN GOTO 3310 2840 IF VA>=1000 AND VA<1050 THEN GOTO 3320 2850 IF VA>=1050 AND VA<1075 THEN GOTO 3330 2860 IF VA>=1075 AND VA<1100 THEN GOTO 3340 2870 IF VA>=1100 AND VA<1110 THEN GOTO 3350 2880 IF VA>=1110 AND VA<1120 THEN GOTO 3360 2890 IF VA>=1120 AND VA<1130 THEN GOTO 3370 2900 IF VA>=1130 AND VA<1150 THEN GOTO 3380 2910 IF VA>=1150 AND VA<1250 THEN GOTO 3390 2920 IF VA>=1250 AND VA<1500 THEN GOTO 3400 2930 IF VA>=1500 AND VA<2000 THEN GOTO 3410 2940 IF VA>=2000 AND VA<2500 THEN GOTO 3420 2950 IF VA>=2500 AND VA<3000 THEN GOTO 3430 2960 IF VA>=3000 AND VA<3500 THEN GOTO 3440 2970 IF VA>=3500 AND VA<4000 THEN GOTO 3450 2980 IF VA>=4000 AND VA<=4500 THEN GOTO 3460 2990 REM ** FIND COEFFICIENTS FOR SUA ** 3000 IF SUA>43041! THEN PRINT " Remaining velocity is out of range of program." 3010 REM IF SUA>43041! THEN PRINT: PRINT " USE TABLES OR CHOOSE HIGHER MUZZLE VELOCITY OR SHORTER RANGE." 3020 IF SUA<=43041! AND SUA>36664.2 THEN GOTO 3250 3030 IF SUA<=36664.2 AND SUA>31488.6 THEN GOTO 3260 3040 IF SUA<=31488.6 AND SUA>27124.6 THEN GOTO 3270 3050 IF SUA<=27124.6 AND SUA>23415.1 THEN GOTO 3280 3060 IF SUA<=23415.1 AND SUA>20325.5 THEN GOTO 3290 3070 IF SUA<=20325.5 AND SUA>17879.9 THEN GOTO 3300 3080 IF SUA<=17879.9 AND SUA>16095.6 THEN GOTO 3310 3090 IF SUA<=16095.6 AND SUA>15433.3 THEN GOTO 3320 3100 IF SUA<=15433.3 AND SUA>15150.3 THEN GOTO 3330 3110 IF SUA<=15150.3 AND SUA>14894.3 THEN GOTO 3340 3120 IF SUA<=14894.3 AND SUA>14798.5 THEN GOTO 3350 3130 IF SUA<=14798.5 AND SUA>14706.2 THEN GOTO 3360 3140 IF SUA<=14706.2 AND SUA>14616.9 THEN GOTO 3370 3150 IF SUA<=14616.9 AND SUA>14447! THEN GOTO 3380 3160 IF SUA<=14447! AND SUA>13720.5 THEN GOTO 3390 3170 IF SUA<=13720.5 AND SUA>12330.3 THEN GOTO 3400 3180 IF SUA<=12330.3 AND SUA>10168.1 THEN GOTO 3410 3190 IF SUA<=10168.1 AND SUA>8332.83 THEN GOTO 3420 3200 IF SUA<=8332.83 AND SUA>6699.05 THEN GOTO 3430 3210 IF SUA<=6699.05 AND SUA>5245.45 THEN GOTO 3440 3220 IF SUA<=5245.45 AND SUA>3958.11 THEN GOTO 3450 3230 IF SUA<=3958.11 AND SUA>2812.29 THEN GOTO 3460 3240 REM ** SUBROUTINES FOR SPACE,TIME FUNCTIONS ** 3250 VBA=350:AAS=39663!:BS=-63.768:CS=.0758391:AT=49.669:BT=-.1845:CT=4.82396E-04:RETURN 3260 VBA=450:AAS=33958.1:BS=-51.756:CS=.0473157:AT=35.269:BT=-.115879:CT=2.34824E-04:RETURN 3270 VBA=550:AAS=29218.7:BS=-43.64:CS=.035161:AT=25.7322:BT=-.079629:CT=1.36695E-04:RETURN 3280 VBA=650:AAS=25192:BS=-37.095:CS=.0311391:AT=18.9904:BT=-.057305:CT=9.20586E-05:RETURN 3290 VBA=750:AAS=21792:BS=-30.896:CS=.0313196:AT=14.1144:BT=-.041349:CT=6.9381E-05:RETURN 3300 VBA=850:AAS=19020.1:BS=-24.4588:CS=.0330303:AT=10.6366:BT=-.0288527:CT=5.58719E-05:RETURN 3310 VBA=950:AAS=16906.5:BS=-17.8388:CS=.0325134:AT=8.27886:BT=-.01884:CT=4.41677E-05:RETURN 3320 VBA=1025:AAS=15747.2:BS=-13.2423:CS=.0276581:AT=7.10211:BT=-.0129298:CT=3.32035E-05:RETURN 3330 VBA=1062.5:AAS=15288.1:BS=-11.3183:CS=.023346:AT=6.66207:BT=-.0106524:CT=2.68757E-05:RETURN 3340 VBA=1087.5:AAS=15019.2:BS=-10.2383:CS=.0199585:AT=6.41183:BT=-9.41688E-03:CT=2.2611E-05:RETURN 3350 VBA=1105:AAS=14846:BS=-9.58136:CS=.0164795:AT=6.25378:BT=-8.66849E-03:CT=2.0396E-05:RETURN 3360 VBA=1115:AAS=14751.9:BS=-9.231361:CS=.0165939:AT=6.16907:BT=-8.28396E-03:CT=1.83284E-05:RETURN 3370 VBA=1125:AAS=14661.2:BS=-8.930021:CS=.0147629:AT=6.08802:BT=-7.93184E-03:CT=1.70991E-05:RETURN 3380 VBA=1140:AAS=14530.6:BS=-8.482001:CS=.0116909:AT=5.97274:BT=-7.45342E-03:CT=1.50953E-05:RETURN 3390 VBA=1200:AAS=14062.5:BS=-7.2568:CS=8.50001E-03:AT=5.57228:BT=-.006058:CT=9.6174E-06:RETURN 3400 VBA=1375:AAS=12977.5:BS=-5.5464:CS=3.06207E-03:AT=4.72557:BT=-4.05656E-03:CT=3.72586E-06:RETURN 3410 VBA=1750:AAS=11189.1:BS=-4.31589:CS=9.60342E-04:AT=3.56969:BT=-2.49074E-03:CT=1.27366E-06:RETURN 3420 VBA=2250:AAS=9222.059:BS=-3.66916:CS=4.5401E-04:AT=2.57801:BT=-1.63915E-03:CT=5.68494E-07:RETURN 3430 VBA=2750:AAS=7492.73:BS=-3.26733:CS=3.71407E-04:AT=1.88267:BT=-.0011924:CT=3.52828E-07:RETURN 3440 VBA=3250:AAS=5950.45:BS=-2.90704:CS=3.48885E-04:AT=1.36656:BT=-8.97071E-04:CT=2.45908E-07:RETURN 3450 VBA=3750:AAS=4582.38:BS=-2.57414:CS=3.10524E-04:AT=.974457:BT=-6.880031E-04:CT=1.74925E-07:RETURN 3460 VBA=4250:AAS=3369.09:BS=-2.29123:CS=2.57709E-04:AT=.670381:BT=-5.40083E-04:CT=1.24357E-07:RETURN 3470 REM ** SUBROUTINE FOR NON-STANDARD METRO ** 3480 INPUT " Enter altitude at gun (feet) ";AL 3490 INPUT " Enter temperature (deg-F) ";TF 3500 RH=0: REM ** STANDARD ICAO RELATIVE HUMIDITY 3510 A=SQR((459.67+TF)/518.67): REM ** MACH RATIO 3520 TAC=.002039*AL*(TF-59): REM ** TEMPERATURE CORRECTION FOR ALTITUDE 3530 ALTC=AL+TAC: REM ** ALTITUDE ADJUSTED FOR TEMPERATURE 3540 BP=29.92/EXP(ALTC/27180): REM ** PRESSURE AT ALTITUDE AND TEMPERATURE 3550 RO=1.1357*BP/(29.92+.065092*TF)-(.065077*RH*EXP(.03288*TF-2.6538)/(459.67+TF)): REM ** RELATIVE ATMOSPHERIC DENSITY RATIO 3560 RETURN 3570 REM *** THIS IS THE START OF THE RECOIL CALCULATION MODULE *** 3580 CLS:PRINT:PRINT TAB(25)"*** Recoil calculations ***":PRINT:PRINT:PRINT 3590 PRINT TAB(13)"Adapted from William C Davis by Mike Williams 1993":PRINT "" 3600 PRINT:PRINT:PRINT:PRINT 3610 PRINT:PRINT TAB(13)"To carry out recoil calculations press .... C" 3620 PRINT:PRINT TAB(13)"To return to begining...................... R" 3630 PRINT 3640 PRINT TAB(57):INPUT A$ 3650 IF A$ = "C" THEN CLS: GOTO 3690 3660 IF A$ = "R" THEN GOTO 130 3670 GOTO 3570 3680 REM **** INPUT AND MODIFIED FOR UK USE ... 16 NOVEMBER 1993... VERSION 1.0 3690 PRINT:PRINT:INPUT " Type of ammunition... 1=bulleted 2=shotshell ";Q2:PRINT 3700 IF Q2<>1 AND Q2<>2 THEN PRINT "Try again":GOTO 3690 3710 INPUT " Cartridge identification ";C$:PRINT "" 3720 INPUT " Type of powder... 1=smokeless 2=black powder ";Q1:PRINT "" 3730 IF Q1<>1 AND Q1<>2 THEN PRINT "Try again":GOTO 3720 3740 IF Q2=1 THEN GOTO 3870 3750 CLS: PRINT 3760 INPUT " Weight of shot in Ounces ";CO:CG=437.5*CO:PRINT "" 3770 PRINT " Weight of wad in Grains ? ":PRINT "" 3780 PRINT " Use actual weight of wad if known , otherwise as below":PRINT 3790 PRINT " approximate weights of fibre wads are as follows:--" 3800 PRINT " 12 Bore -- 40 Grains" 3810 PRINT " 16 Bore -- 30 Grains" 3820 PRINT " 20 Bore -- 25 Grains" 3830 PRINT 3840 INPUT " Enter your value ",WW:PRINT "" 3850 WB=CG+WW: REM WEIGHT OF SHOT AND WADS 3860 GOTO 3880 3870 INPUT " Bullet weight in Grains ............... ";WB 3880 INPUT " Charge weight in Grains ............... ";WC 3890 INPUT " Muzzle velocity in Feet per Second .... ";VB 3900 INPUT " Weight of gun in Pounds ............... ";WG 3910 IF Q1=1 THEN VC=4000 3920 IF Q1=2 THEN VC=2000 3930 I=(WB*VB+WC*VC)/225400!:VG=32.17405*I/WG:EG=WG*VG^2/54.4:CLS 3940 PRINT TAB(35)"*** Recoil data ***":PRINT 3950 IF Q1=2 THEN PRINT TAB(20)"Black Powder":PRINT "":GOTO 3970 3960 PRINT TAB(20)"Smokeless powder":PRINT "" 3970 PRINT TAB(20);C$:PRINT "" 3980 IF Q2=2 THEN PRINT " Shot weight in Ounces ...........";TAB(35);CO 3990 IF Q2=2 THEN PRINT " Wad weight in Grains ............";TAB(35);WW:GOTO 4010 4000 PRINT " Bullet weight in Grains .........";TAB(35);WB 4010 PRINT " Charge weight in Grains .........";TAB(35);WC 4020 PRINT " Muzzle velocity in ft/sec .......";TAB(35);VB 4030 PRINT " Gun weight in Pounds ............";TAB(35);WG 4040 PRINT " Recoil impulse in lb/sec ........";TAB(35);:PRINT USING "###.##";I 4050 PRINT " Free-recoil velocity in ft/sec ..";TAB(35);:PRINT USING "###.##";VG 4060 PRINT " Free recoil energy in ft/lbs ....";TAB(35);:PRINT USING "###.##";EG:PRINT "" 4070 INPUT " Do you want to print this data... 1=Yes 2=No ";Q3: PRINT 4080 IF Q3=1 THEN GOSUB 4120 4090 INPUT " What do you want to do now ... 1=calculate recoil OR 2=return to start ";Q4 4100 IF Q4=1 THEN CLS: GOTO 3690 4110 IF Q4=2 THEN GOTO 170 4120 ON ERROR GOTO 4270: LPRINT TAB(6);"*** Recoil data ***": LPRINT" " 4130 IF Q1=2 THEN LPRINT TAB(11)"Black Powder": LPRINT" ": GOTO 4150 4140 LPRINT TAB(8)"Smokless powder": LPRINT" " 4150 LPRINT C$ 4160 IF Q2=2 THEN LPRINT "Shot weight in Ounces ........ ";TAB(35);CO 4170 IF Q2=2 THEN LPRINT "Wad weight in Grains ......... ";TAB(35);WW: GOTO 4190 4180 LPRINT "Bullet weight in Grains .........";TAB(35);WB 4190 LPRINT "Charge weight in Grains .........";TAB(35);WC 4200 LPRINT "Muzzle velocity in ft/sec .......";TAB(35);VB 4210 LPRINT "Gun weight in Pounds ............";TAB(35);WG 4220 LPRINT "Recoil impulse in lb/sec ........";TAB(35);:LPRINT USING "###.##";I 4230 LPRINT "Free-recoil velocity in ft/sec ..";TAB(35);:LPRINT USING "###.##";VG 4240 LPRINT "Free-recoil energy in ft/lbs ....";TAB(35);:LPRINT USING "###.##";EG 4250 LPRINT:LPRINT:LPRINT 4260 RETURN 4270 CLS 4280 PRINT:PRINT:PRINT:PRINT:PRINT 4290 PRINT TAB(12) "The printer is either not switched on or not connected" 4300 PRINT:PRINT:PRINT 4310 PRINT TAB(12) "To continue please make sure that the printer is ready" 4320 PRINT:PRINT:PRINT 4330 PRINT " Enter (C) to Continue" 4340 INPUT " (E) to Exit ";P$ 4350 IF P$="C" THEN RESUME 4360 IF P$="E" THEN SYSTEM 4370 CLS 4380 PRINT: PRINT " THIS MODULE IS NOT YET PRESENT" 4390 INPUT " (E) TO EXIT OR (R) TO RESUME FROM THE BEGINING ";LO$ 4400 IF LO$="E" THEN SYSTEM 4410 IF LO$="R" THEN GOTO 130 4420 GOTO 4370 4430 CLS 4440 PRINT:PRINT:PRINT 4450 PRINT " CHOOSE TEXT COLOUR ...... 0 = BLACK" 4460 PRINT " 1 = BLUE" 4470 PRINT " 2 = GREEN" 4480 PRINT " 3 = CYAN" 4490 PRINT " 4 = RED" 4500 PRINT " 5 = MAGENTA" 4510 PRINT " 6 = BROWN" 4520 PRINT " 7 = WHITE" 4530 PRINT " 8 = GRAY" 4540 PRINT " 9 = LIGHT BLUE" 4550 PRINT " 10 = LIGHT GREEN" 4560 PRINT " 11 = LIGHT CYAN" 4570 PRINT " 12 = LIGHT RED" 4580 PRINT " 13 = LIGHT MAGENTA" 4590 PRINT " 14 = YELLOW" 4600 PRINT " 15 = BRIGHT WHITE" 4610 PRINT:INPUT " ENTER YOUR CHOICE ....... ";TEX% 4620 CLS 4630 PRINT:PRINT:PRINT 4640 PRINT " CHOOSE BACKGROUND COLOUR 0 = BLACK" 4650 PRINT " 1 = BLUE" 4660 PRINT " 2 = GREEN" 4670 PRINT " 3 = CYAN" 4680 PRINT " 4 = RED" 4690 PRINT " 5 = MAGENTA" 4700 PRINT " 6 = BROWN" 4710 PRINT " 7 = WHITE" 4720 PRINT " 8 = GRAY" 4730 PRINT " 9 = LIGHT BLUE" 4740 PRINT " 10 = LIGHT GREEN" 4750 PRINT " 11 = LIGHT CYAN" 4760 PRINT " 12 = LIGHT RED" 4770 PRINT " 13 = LIGHT MAGENTA" 4780 PRINT " 14 = YELLOW" 4790 PRINT " 15 = BRIGHT WHITE" 4800 PRINT:INPUT " ENTER YOUR CHOICE ....... ";BAK% 4810 GOTO 160 Revised 24-Nov-2021.
|