In BASIC
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
Revised 07-May-2010.