10 REM ********************************
20 REM * LIST LOCATOR.BAS *
30 REM * Program f|r utr{kning av av- *
40 REM * st}nd, b{ring och po{ng vid *
50 REM * tester. B}de gammal och ny *
60 REM * locator kan anv{ndas. Summa *
70 REM * QSO & po{ng ges vid avslutn. *
80 REM * Ins{nt av Kurt Eriksson <396>*
90 REM ********************************
95 ! WIDTH 40 F\R ABC802 OCH 806
100 ; CHR$(12) CUR(0,0);
110 ; "*** SM7DOX *** LOCATOR *** SM5BKK ***" : ;
120 REM IMPLEMENTED ON ABC-80 BY Jan Hov`n, 790805.
130 REM Ny locator enl QTC 6/80 Kurt Eriksson 1985-01-05
140 ; "Ber{knar avst}nd, riktning och testpo{ngmellan QTH 1 och QTH 2." : ;
170 ; "Ge ny el. gammal locator eller Lat,Long."
190 ; TAB(10);
200 ; "Input som Lat,Long....svara 0"
210 ; TAB(10);
220 ; "F|r att {ndra QTH 1...svara 1"
230 ; TAB(10);
240 ; "Avsluta programmet....svara 2"
250 G$=CHR$(151)
260 T$=CHR$(135)
270 ; CUR(10,9);
280 ; G$ "<,,,,,,,,<,,,,,,,,,<,,,,,,,,,l"
290 ; CUR(11,9) G$ "5" T$ "Loc. " G$ "5";
300 ; T$ "Lat. " G$ "5" T$ "Long. " G$ "j";
310 ; G$ "<,,,,,,,,=,,,,,,,,=,,,,,,,,,=,,,,,,,,,n";
320 ; G$ "5" T$ "QTH 1:" G$ "5" T$ " " G$ "5" T$ " " G$ "5" T$ " " G$ "j";
330 ; G$ "=,,,,,,,,=,,,,,,,,=,,,,,,,,,=,,,,,,,,,n";
340 ; G$ "5" T$ "QTH 2:" G$ "5" T$ " " G$ "5" T$ " " G$ "5" T$ " " G$ "j";
350 ; G$ "-,,,,,,,,-,,,,,,,,-,,,,,,,,,-,,,,,,,,,.";
360 ; G$ "<" STRING$(15,44) "<" STRING$(10,44) "<" STRING$(10,44) "l";
370 ; G$ "5" T$ "QRB: km" G$ "5" T$ "QTE: " G$ "5" T$ "P: " G$ "j";
380 ; G$ "-" STRING$(15,44) "-" STRING$(10,44) "-" STRING$(10,44) ".";
390 ; G$ "<" STRING$(19,44) "<" STRING$(17,44) "l";
400 ; G$ "5" T$ "Input " G$ "5" T$ SPACE$(15) G$ "j";
410 ; G$ "-" STRING$(19,44) "-" STRING$(17,44) ".";
420 REM
430 REM CONSTANTS
440 REM ---------
450 R1=6378.38 : R2=6356.91
460 M=PI/180
470 DEF FNA(X)=PI/2-ATN(X/SQR(1-X^2%))
480 E1=(R1*R1-R2*R2)/(R2*R2)
490 DIM Q$(3)=2
500 REM
510 REM INPUT OF VALUES
520 REM ---------------
530 REM --- QTH-LOC 1 ---
540 REM
550 ; CUR(21,9) "LOCATOR 1:"
560 ; CUR(21,23) SPACE$(15)
570 ON ERROR GOTO 550
580 ; CUR(21,23); : INPUT A$
590 ; CUR(13,12) " "
600 ; CUR(13,21) " "
610 ; CUR(13,31) " "
620 IF A$="0" THEN 660
630 IF A$="2" THEN 1850
640 GOSUB 1190 : IF F1%=1% THEN 550 ELSE IF N%=1% 700
650 GOSUB 1070 : GOTO 700
660 ; CUR(21,9) "Lat,Long 1:"
670 ; CUR(21,23) SPACE$(15)
680 ; CUR(21,23); : INPUT A3,A4
690 GOSUB 2049
700 ; CUR(13,12) A$
710 ; CUR(13,21) INT(100*A3+.5)/100
720 ; CUR(13,31) INT(100*A4+.5)/100
730 A1=M*A3 : A2=M*A4
740 B1=PI/2-ATN(R2*TAN(A1)/R1)
750 C1=SIN(B1) : C2=COS(B1)
760 REM --- QTH-LOC 2 ---
770 REM
780 ; CUR(21,9) "LOCATOR 2:"
790 ; CUR(21,23) SPACE$(15)
800 ON ERROR GOTO 780
810 ; CUR(21,23); : INPUT A$
820 ; CUR(15,12) " "
830 ; CUR(15,21) " "
840 ; CUR(15,31) " "
850 ; CUR(18,7) " "
860 ; CUR(18,23) " " CUR(18,32) " "
870 IF A$="0" THEN 920
880 IF A$="1" THEN 550
890 IF A$="2" THEN 1850
900 GOSUB 1190 : IF F1%=1% THEN 780 ELSE IF N%=1% 960
910 GOSUB 1070 : GOTO 960
920 ; CUR(21,9) "Lat,Long 2:"
930 ; CUR(21,23) SPACE$(14)
940 ; CUR(21,23); : INPUT A3,A4
950 GOSUB 2049
960 ; CUR(15,12) A$
970 ; CUR(15,21) INT(100*A3+.5)/100
980 ; CUR(15,31) INT(100*A4+.5)/100
990 A3=M*A3 : A4=M*A4
1000 GOSUB 1360
1010 ; CUR(18,7) INT(A6+.5)
1020 ; CUR(18,23) INT(A5+.5)
1025 ; CUR(18,32) P
1030 GOTO 780
1040 REM
1050 REM DECODING QTH-LOC. (GAMLA)
1060 REM -------------------------
1070 REM A3=LAT,A4=LONG,A5=RIKTN,A6=AVST,A1=LAT1,A2=LONG1
1080 A4=1/30+2*(ASCII(MID$(A$,1,1))-65)
1090 A3=1/48-25+ASCII(MID$(A$,2,1))
1100 C%=VAL(MID$(A$,3,2))-1%
1110 A4=A4+(C%-10%*(C%/10%))/5
1120 A3=A3+(7%-C%/10%)/8
1130 D$=MID$(A$,5,1)
1140 IF D$="G" OR D$="J" OR D$="C" THEN A3=A3+1/24
1150 IF D$="H" OR D$="A" OR D$="B" THEN A3=A3+1/12
1160 IF D$="B" OR D$="C" OR D$="D" THEN A4=A4+2/15
1170 IF D$="A" OR D$="J" OR D$="E" THEN A4=A4+1/15
1180 RETURN
1190 F1%=0% : N%=0% : REM FELRUTIN
1200 IF LEN(A$)=5% THEN 1210
1203 IF LEN(A$)=6% THEN 1900
1205 GOTO 1300
1210 F%=ASCII(MID$(A$,1%,1%))
1220 IF F%<65% OR F%>90% THEN 1300
1230 F%=ASCII(MID$(A$,2%,1%))
1240 IF F%<65% OR F%>90% THEN 1300
1250 F%=VAL(MID$(A$,3%,2%))
1260 IF F%<1% OR F%>80% THEN 1300
1270 F%=ASCII(MID$(A$,5%,1%))
1280 IF F%<65% OR F%=73% OR F%>74% THEN 1300
1290 GOTO 1310
1300 F1%=1%
1310 RETURN
1320 REM
1330 REM CAL. OF DISTANCE & AZIMUTH
1340 REM lat & long i radianer
1350 REM --------------------------
1360 F=(A1+A3)/2
1370 L=ABS(A2-A4)
1380 IF L>PI THEN L=2*PI-L
1390 B=(A1-A3)^2%
1400 N=E1*COS(F)^2%
1410 T=TAN(F)^2%
1420 D1=SIN(F) : D2=COS(F)
1430 L1=60*B*N*(1+N+3*T+6*N*T)/(1+N)^2%
1440 L2=120*N*(L*D1)^2%
1450 L3=B*B*N*(1+15*T)
1460 L4=2*B*N*(1+10*T-15*T*T)*(L*D2)^2%
1470 L5=6*N*T*(3-T)*(L*D2)^4%
1480 L6=L*SQR(1+N)*(1440-L1-L2-L3-L4-L5)/1440
1490 B3=PI/2-ATN(R2*TAN(A3)/R1)
1500 X=C2*COS(B3)+C1*SIN(B3)*COS(L6)
1510 IF 1-X*X>.0003 THEN S=FNA(X) : GOTO 1530
1520 S=SQR(B+(L*D2)^2%)
1530 Q=(COS(B3)-C2*COS(S))/(C1*SIN(S))
1540 IF 1-Q*Q>.0003 THEN A5=FNA(Q) : GOTO 1560
1550 IF A1>A3 THEN A5=PI ELSE A5=0
1560 L1=60*B*N*(1-N-T-6*N*T)/(1+N)^2%
1570 L2=120*N*(L*D1)^2%
1580 L3=3*B*B*N*(1-T)
1590 L4=2*B*N*(1-2*T-15*T*T)*(L*D2)^2%
1600 L5=2*N*(9*T-5*T*T)*(L*D2)^4%
1610 A6=1440*S*R1/((1440-L1-L2-L3-L4-L5)*SQR(1+N))
1615 P=INT((A6+10)/10) : IF P>200 THEN P=200
1617 P1=P1+P : Q1%=Q1%+1%
1620 IF A2<0 THEN 1670
1630 IF A4