Ballistics Program

In 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 both GW BASIC and QBASIC. It is thought that the program will run under other forms of BASIC, but it 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=blackpowder ";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)"Blackpowder":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)"Blackpowder": 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


Site Map

Back to top

Back to Ballistics Program

Back to home page

Revised 18-Jan-2017.