home *** CD-ROM | disk | FTP | other *** search
- 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 HAS BEEN ADAPTED TO BASIC-E OR CBASIC
- 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)
- 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 " TYPE ANY CHARACTER 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" THEN GOTO 1980
- 670 IF BB$ = "FIND" THEN GOTO 1680
- 680 IF BB$ = "CHANGE" THEN 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 IF TM >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 GOTO 810
- 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";:PRINT USING QQ$;CX(NC);
- 1060 PRINT TAB(25);:PRINT USING QQ$;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 PRINT USING QQ$;XM:
- 1220 PRINT "ESTIMATED ELT LOCATION Y=";
- 1230 PRINT USING QQ$;YM:PRINT
- 1240 IF NC < 3 THEN 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";:PRINT USING QB$;SK;:PRINT" DEGREES"
- 1580 PRINT "ELLIPSE DIMENSION A";:PRINT USING QQ$;A
- 1590 PRINT "ELLIPSE DIMENSION B";:PRINT USING QQ$;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 PRINT USING QC$;I;:PRINT USING QB$;EX(I);
- 2020 PRINT USING QB$;WY(I);:PRINT USING QD$;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) THEN GOTO 1080
- 2310 PRINT " DO YOU WANT TO KEEP IT";
- 2320 INPUT AZ$
- 2330 IF AZ$ ="YES" THEN 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
-