10 REM THIS IS A DIRECTION FINDING ASSISTANCE PROGRAM
 20 REM AND WILL CALCULATE A MEAN FIX AND AN ELLIPSE
 30 REM OF 50 (OR INPUT)PERCENT PROBABILITY CONTOUR FOR MOST LIKELY
 40 REM AREA OF TARGET FIND
 45 REM THIS PROGRAM WAS WRITTEN IN MICROSOFT BASIC
 46 REM AND RUN ON A MITS ATTACHE COMPUTER
 50 REM WRITTEN BY CHRISTOPHER P. KELLY
 60 REM AMATEUR RADIO EMERGENCY SERVICES
 70 REM ALBUQUERQUE, NEW MEXICO
 80 REM THE VARIABLES USED HERE ARE REPRESENTING THE FOLLOWING
 90 REM EX - STATION X COORDINATE
100 REM WY - STATION Y COORDINATE
110 REM BE - BEARING AT THAT STATION
120 REM SL - SLOPE OF LINE FOR THAT STATION
130 REM IN - Y INTERCEPT OF LINE FOR THAT STATION
140 REM CX - CUT X COORDINATE
150 REM CY - CUT Y COORDINATE
160 REM NC - NUMBER OF CUTS
170 REM LA - LATEST BEARING NUMBER
180 REM DI - DIFFERENCE DEGREES BETWEEN BEARINGS
190 REM SX - SUM OF X COORDINATES
200 REM SY - SUM OF Y COORDINATES
210 REM XM - MEAN X VALUE
220 REM YM - MEAN Y OF VALUES
230 REM XV - VARIANCE OF X'S
240 REM YV - VARIANCE OF Y'S
250 REM A1-A5 ELEMENTS OF ELLIPSE EQUATION
260 REM A - ELLIPSE SIZE IN SKEW DIRECTION
270 REM
280 REM B - ELLIPSE DIMENSION NORMAL TO SKEW DIRECTION
290 REM PR - PROBABILITY CONTOUR
300 DIM EX(30),WY(30),BE(30),SL(30),IN(30)
310 DIM CX(300),CY(300),X(20),Y(20),Z(20)
320 DEFINT L
330 DEFINT N
340 PRINT:PRINT:PRINT:PRINT
350 PRINT " NATIONAL ELT LOCATION TEAM (NELT)":PRINT
360 PRINT " WELCOME TO THE ELT DF PRAM"
370 PRINT " THIS PROGRAM WILL PLOT THE ESTIMATED LOCATION "
380 PRINT " OF A ELT ON AN X,Y COORDINATE SYSTEM, USING"
390 PRINT " AS INPUT THE X,Y LOCATION OF FIELD TEAMS"
400 PRINT " AND THEIR BEARINGS TO THE ELT."
410 PRINT " THE USER MAY ALSO LIST ALL ACCUMULATED CROSSINGS"
420 PRINT " OF BEARINGS (CUTS) OR CHANGE THE PROBABILITY"
430 PRINT " PERCENTAGE OF THE ELLEPTICAL PATTERN (A "
440 PRINT " STATISTICAL MEASURE OF AGREEMENT OF "
450 PRINT " THE CUTS WITH EACH OTHER). THE PROGRAM CAN ALSO "
460 PRINT " COMPUTE THE X,Y LOCATION OF THE DF TEAM (IF IT IS"
470 PRINT " NOT KNOWN) BY USE OF BEACONS OR LANDMARKS"
480 PRINT
490 INPUT " HIT RETURN KEY TO CONTINUE";$ZZ
500 PRINT:PRINT
510 PRINT "IF COMPASS DECLINATION IS OTHER THAN TRUE "
520 INPUT "ENTER COMPASS DECLINATION, DEGREES";OF
530 PRINT:PRINT:PRINT:PRINT:PRINT:PRINT:PRINT
540 NC=0:LA=0:AO=1000:BO=1000
550 PR=.5
560 PRINT " THE FOLLOWING OPTIONS ARE AVAILABLE"
570 PRINT
580 PRINT " EDIT   - EDIT DATA ALREADY ENTERED "
590 PRINT " FIND   - LOCATE FIELD D F TEAM"
600 PRINT " CHANGE - CHANGE PROBABILITY PERCENTAGE"
610 PRINT " AVERAGE- BASELINE AVERAGE ROUTINE"
620 PRINT " COMPUTE- RECOMPUTE WITH CURRENT DATA"
630 PRINT " MAG    - SET MAGNETIC DECLINATION"
640 PRINT
650 INPUT " ENTER COMMAND";BB$
660 IF BB$ = "EDIT" GOTO 1980
670 IF BB$ = "FIND" GOTO 1680
680 IF BB$ = "CHANGE" GOTO 1930
690 IF BB$ = "COMPUTE" THEN GOTO 880
700 IF BB$ = "MAG" THEN GOSUB 2770
710 IF BB$ = "AVERAGE" THEN GOSUB 2380
720 LA=LA+1
730 PRINT:INPUT" ENTER FIELD DF TEAM LOCATION X";TM
740 EX(LA) = TM
750 IFTM >50 THEN LA=LA-1
760 IF TM > 50 THEN GOTO 580
770 INPUT" ENTER FIELD DF TEAM LOCATION Y";WY(LA)
780 INPUT" ENTER FIELD DF TEAM BEARING TO ELT ";BE(LA)
790 IF BE(LA)<360 THEN GOTO810
800 PRINT "CANCELLING LAST X,Y. REENTER PLEASE ":GOTO 730
810 BE(LA)=BE(LA)+OF
820 IF BE(LA)>360 THEN BE(LA)=BE(LA)-360
830 IF BE(LA) = 180 THEN BE(LA)=179.9
840 IF BE(LA) = 360 THEN BE(LA)=359.9
850 IF BE(LA) = 0 THEN BE(LA)=359.9
860 SL(LA)=TAN((90-BE(LA))/57.2958)
870 IN(LA)=WY(LA)-(SL(LA)*EX(LA))
880 IF LA<2 THEN GOTO 720
890 N1=0
900 NC=0
910 FOR I = 1 TO LA-1
920 FOR J = I+1 TO LA
930 IA=I
940 REM FIRST CHECK FOR TWO ANGLES TOO CLOSE
950 DI=BE(I)-BE(J)
960 IF ABS(TAN(DI/57.2958)) < .5 THEN GOTO 2270
970 NC=NC+1
980 N1=N1+1
990 CX(NC)=(IN(I)-IN(J))/(SL(J)-SL(I))
1000 CY(NC)=(SL(J)*CX(NC))+IN(J)
1010 QQ$="###.##"
1020 QC$="##"
1030 QD$="####"
1040 QB$="####.#"
1050 PRINT "NEW CUT COORDINATES X,Y";:PRINTUSINGQQ$;CX(NC);
1060 PRINTTAB(25);:PRINTUSINGQQ$;CY(NC)
1070 NEXT J
1080 NEXT I
1090 REM SEE IF WE HAVE ENOUGH CUTS YET
1100 IF NC<2 THEN GOTO 720
1110 REM NOW CALCULATE THE SUM OF THE CUTS
1120 SX=0:SY=0
1130 FOR I = 1 TO NC
1140 SX=SX+CX(I)
1150 SY=SY+CY(I)
1160 NEXT I
1170 XM=SX/NC
1180 YM=SY/NC
1190 PRINT
1200 PRINT:PRINT "ESTIMATED ELT LOCATION X=";
1210 PRINTUSINGQQ$;XM:
1220 PRINT "ESTIMATED ELT LOCATION Y=";
1230 PRINTUSINGQQ$;YM:PRINT
1240 IF NC < 3 GOTO 730
1250 SM=0:XV=0:YV=0
1260 FOR I = 1 TO NC
1270 XV=XV+((CX(I)-XM)^2)
1280 YV=YV+((CY(I)-YM)^2)
1290 SM=SM+(CX(I)*CY(I))
1300 NEXT I
1310 XA=XV/(NC-1)
1320 YA=YV/(NC-1)
1330 DX=SQR(XV)
1340 DY=SQR(YV)
1350 IF DX*DY = 0 THEN PRINT" ALL CUTS SAME"
1360 IF DX*DY = 0 THEN GOTO 720
1370 RH=((SM/NC)-(XM*YM))/(DX*DY)
1380 SR=(.5*(ATN(2*RH*DX*DY))/(XV-YV))
1390 SK=90-(SR*57.296)
1400 IF SK < 0 THEN SK=SK+360
1410 IF SK >360 THEN SK=SK-360
1420 REM NOW WE WILL CALCULATE K PROBABILITY CONTOUR
1430 K=-2*LOG(1-PR)
1440 REM
1450 REM BEGIN TO CALCULATE THE BIG ELLIPSE EQUATION
1460 REM
1470 A1=(1!-RH^2)*K
1480 A2=(COS(SR)^2)/XA
1490 A3=(2*RH*SIN(SR)*COS(SR))/(DX*DY)
1500 A4=(SIN(SR)^2)/YA
1510 A5=(SIN(SR)^2)/XA
1520 A6=(COS(SR)^2)/YA
1530 REM HERE WE GO WITH COMPOSITE EQUATION
1540 A=A1/(A2-A3+A4)
1550 B=A1/(A5+A3+A6)
1560 PRINT "FOR PROBABILITY OF "PR*100" PERCENT":PRINT
1570 PRINT "ELLIPSE A AXIS";:PRINTUSINGQB$;SK;:PRINT" DEGREES"
1580 PRINT "ELLIPSE DIMENSION A";:PRINTUSINGQQ$;A
1590 PRINT "ELLIPSE DIMENSION B";:PRINTUSINGQQ$;B
1600 PRINT
1610 PRINT
1620 AO=A
1630 BO=B
1640 GOTO 720
1650 REM THIS SUBPROGRAM IS DESIGNED TO CALCULATE THE
1660 REM LOCATION OF A SEARCHER IN THE FIELD BY USE
1670 REM OF HIS BEARINGS TO TWO KNOWN BEACON STATIONS
1680 PRINT "ENTER FIRST KNOWN LANDMARK OR BEACON X,Y";
1690 INPUT AX,AY
1700 PRINT "ENTER BEARING FROM TEAM TO FIRST LANDMARK";
1710 INPUT B1
1720 PRINT "ENTER SECOND KNOWN LANDMARK OR BEACON X,Y";
1730 INPUT BX,BY
1740 PRINT "ENTER BEARING FROM TEAM TO SECOND LANDMARK";
1750 INPUT B2
1760 REM NOW CONVERT BEARINGS TO REVERSE BEARINGS,
1770 REM FROM BEACON TO SEARCHER
1780 B1=B1+180
1790 B2=B2+180
1800 IF B2 > 360 THEN B2=B2-360
1810 IF B1 > 360 THEN B1=B1-360
1820 REM NOW START SOLVING THE LINE INTERCEPTS
1830 S1=TAN((90-B1)/57.2958)
1840 S2=TAN((90-B2)/57.2958)
1850 I1=AY-(S1*AX)
1860 I2=BY-(S2*BX)
1870 REM NOW SOLVE FOR SEARCHERS LOCATION
1880 SX=(I1-I2)/(S2-S1)
1890 SY=(S1*SX)+I1
1890 REM HERE WE TELL THE USER WHAT WE FOUND
1910 PRINT "SEARCHER LOCATION X,Y:"SX,SY
1920 GOTO 720
1930 INPUT "ENTER PROBABILITY CONTOUR %";PR
1940 IF PR < 99.9 AND PR > 1 THEN GOTO 1960
1950 PRINT " ILLEGAL VALUE, REENTER":GOTO 1930:
1960 PR=PR/100!
1970 GOTO 1420
1980 PRINT " DUMP OF BEARINGS:"
1990 PRINT "NUM   X     Y   MAG BEARING"
2000 FOR I = 1 TO LA
2010 PRINTUSINGQC$;I;:PRINTUSINGQB$;EX(I);
2020 PRINTUSINGQB$;WY(I);:PRINTUSINGQD$;BE(I)
2030 NEXT I
2040 PRINT "COMMANDS: CHANGE(C)-DELETE(D)-OK(O)";
2050 INPUT BB$
2060 IF BB$ = "C" THEN GOTO 2090
2070 IF BB$ = "D" THEN GOTO 2140
2080 GOTO 720
2090 INPUT "BEARING NUMBER";BN
2100 INPUT "ENTER NEW X COORDINATE";EX(BN)
2110 INPUT "ENTER NEW Y COORDINATE";WY(BN)
2120 INPUT "ENTER NEW BEARING TO TARGET";BE(BN)
2130 GOTO 880
2140 INPUT "DELETE WHICH BEARING (NUMBER)";BN
2150 IF BN > 0 AND BN <LA THEN GOTO 2180
2160 IF BN = LA THEN LA=LA-1
2170 GOTO 720
2180 FOR I = BN TO LA
2190 BE(I)=BE(I+1)
2200 EX(I)=EX(I+1)
2210 WY(I)=WY(I+1)
2220 SL(I)=SL(I+1)
2230 IN(I)=IN(I+1)
2240 NEXT I
2250 LA=LA-1
2260 GOTO 880
2270 PRINT "THERE IS A TIGHT ANGLE HERE"
2280 PRINT " BEARINGS:" BE(LA),BE(IA)
2290 IF SL(IA)=SL(LA)THEN PRINT "SAME ANGLE-CUT REJECTED"
2300 IF SL(IA)=SL(LA) GOTO 1080
2310 PRINT " DO YOU WANT TO KEEP IT";
2320 INPUT AZ$
2330 IF AZ$ ="YES" GOTO 970
2340 GOTO 1080
2350 REM HERE IS THE BASELINE AVERAGING CODE
2360 REM
2370 PRINT
2380 PRINT "BASELINE AVERAGING WILL AID YOU IN OBTAINING"
2390 PRINT "A BETTER BEARING IN POOR CONDITIONS, START BY"
2400 PRINT "ENTERING THE X AND Y LOCATIONS TO BE AVERAGED"
2410 PRINT "AND THE BEARINGS FROM THOSE LOCATIONS "
2420 PRINT "IF ALL THE BEARINGS ARE TAKEN FROM THE SAME"
2430 PRINT"APPROXIMATE LOCATION, THEN ENTER THAT SAME LOCATION"
2440 PRINT "FOR EACH BEARING. WHEN YOU HAVE ENTERED ALL THE"
2450 PRINT "INFORMATION YOU HAVE, ENTER A NUMBER GREATER THAN"
2460 PRINT "50 FOR X, AND THE PROGRAM WILL CALCULATE THE"
2470 PRINT "AVERAGED LOCATION AND BEARING AND WILL TELL YOU"
2480 PRINT "THE RESULT AND RETURN YOU TO THE MAIN PROGRAM"
2490 PRINT "EACH TIME YOU ENTER THIS SUBROUTINE YOU START"
2500 PRINT "WITH FRESH DATA, NONE IS STORED FROM LAST RUN"
2510 PRINT
2520 N=0
2530 N=N+1
2540 INPUT "ENTER THE X LOCATION>";X(N)
2550 IF X(N)>50 THEN GOTO 2590
2560 INPUT "ENTER THE Y LOCATION>";Y(N)
2570 INPUT "ENTER THE BEARING>";Z(N)
2580 GOTO 2530
2590 N=N-1
2600 CS=0:SS=0:YY=0:XX=0
2610 FOR I = 1 TO N
2620 AN=Z(I)/57.2958
2630 SS=SS+SIN(AN)
2640 CS=CS+COS(AN)
2650 XX=XX+X(I)
2660 YY=YY+Y(I)
2670 NEXT I
2680 SS=SS/N:CS=CS/N:XX=XX/N:YY=YY/N
2690 AB=ATN(SS/CS)*57.2958
2700 IF CS<0 THEN AB=AB+180
2710 IF AB<0 THEN AB=AB+360
2720 PRINT
2730 PRINT "AVERAGE X=",XX," AVERAGE Y=",YY
2740 PRINT "AVERAGE BEARING",AB" DEGREES"
2750 PRINT "RETURNING TO MAIN PROGRAM":PRINT
2760 RETURN
2770 PRINT:PRINT"CURRENT DECLINATION IS ",OF," DEGREES"
2780 INPUT "ENTER THE DESIRED DECLINATION";OF
2790 RETURN
2800 END