1 REM Bernt Johansson <3384> 1985-07-31 00.30.32
9 REM * DISTANCE.BAC *
10 REM PROGRAM FOR THE CALCULATION OF THE DISTANCE BETWEEN
20 REM TWO POINTS ON THE EARTH. MADE BY A. GUSTAVSSON
30 REM DATE 800105
35 INTEGER : EXTEND : DOUBLE
40 REM *
41 REM * Date / Ver.Rev / Sign / Note
42 REM * 84-09-26 / X.XX / BJ / Slightly modified for ABC. Orig. QTC 10/-81
50 REM *
60 PRINT "QTH-LOC 1?, IF ANSWER WITH 0, INPUT AS LAT/LONG"
70 PRINT "QTH-LOC 2?, IF ANSWER WITH 0, INPUT AS LAT/LONG"
80 PRINT " -''- 1, INPUT OF NEW QTH-LOC 1"
90 PRINT " -''- 3, END OF PROGRAM"
100 PRINT "AFTER INPUT OF QTH-LOC 2 THERE WILL BE AN ?,"
110 PRINT "IF THE ANSWER IS PRINT THERE WILL BE AN"
120 PRINT "OUTPUT OF LAT/LONG FOR THE POINTS."
130 REM
140 REM CONSTANTS AND STRINGS
150 REM
180 LET C$="76543210"
190 LET D$="1234567890"
200 LET Erade.=6378.14 ! * Earth radius at equator
210 LET Eradp.=Erade.*(1.-1./298.2564) ! * Earth radius at poles
220 LET Degrad.=PI/180
230 M1.=PI/2
240 LET E1.=(Erade.*Erade.-Eradp.*Eradp.)/(Eradp.*Eradp.)
250 LET R3.=1./(Degrad.*Degrad.)
260 LET R4.=R3.*R3.
290 REM
300 REM DECODING OF QTH-LOCATOR
310 REM
320 PRINT "QTH-LOC 1"
330 INPUT A$
340 IF CHR$(ASCII(A$))<>'0' THEN 370
350 INPUT Lat0.,Long0.
360 GOTO 400
370 GOSUB 520
380 LET Lat0.=Latx.
390 LET Long0.=Longx.
400 PRINT "QTH-LOC 2"
410 INPUT A$
420 IF CHR$(ASCII(A$))='1' THEN 320
430 IF CHR$(ASCII(A$))='3' THEN 1460
440 IF CHR$(ASCII(A$))<>'0' THEN 470
450 INPUT Latx.,Longx.
460 GOTO 480
470 GOSUB 520
480 INPUT A$
490 IF CHR$(ASCII(A$) OR 32)='p' THEN 1000
501 PRINT "LAT/LONG 1 ";Lat0.;"/";Long0.;" LAT/LONG 2 ";Latx.;"/";Longx.
510 GOTO 1000
520 Latx.=0. : Longx.=0.
530 LET Pos=1
540 IF INSTR(1,'123',MID$(A$,6,1)) THEN 570
550 LET Latx.=26.
560 GOTO 590
570 IF INSTR(1,'789',MID$(A$,6,1)) THEN 590
580 LET Latx.=-26.
590 IF MID$(A$,2,1)=CHR$(Pos+64) THEN 620
600 LET Pos=Pos+1
610 GOTO 590
620 LET Latx.=Latx.+39.+1./48.+Pos
630 LET Pos=1
640 IF MID$(A$,3,1)='8' THEN 710
650 IF MID$(A$,3,1)=MID$(C$,Pos,1) THEN 680
660 LET Pos=Pos+1
670 GOTO 650
680 IF MID$(A$,4,1)<>'0' THEN 700
690 LET Pos=Pos+1
700 LET Latx.=Latx.+(Pos-1)/8.
710 LET Pos=1
720 IF INSTR(1,'ABH',MID$(A$,5,1))=0 THEN 750
730 LET Latx.=Latx.+1./12.
740 GOTO 770
750 IF INSTR(1,'CGJ',MID$(A$,5,1))=0 THEN 770
760 LET Latx.=Latx.+1./24.
770 IF INSTR(1,'147',MID$(A$,6,1))=0 THEN 800
780 LET Longx.=-52.
790 GOTO 820
800 IF INSTR(1,'369',MID$(A$,6,1))=0 THEN 820
810 LET Longx.=52.
820 IF MID$(A$,1,1)=CHR$(Pos+64) THEN 850
830 LET Pos=Pos+1
840 GOTO 820
850 LET Longx.=Longx.+(Pos-1)*2+1./30.
860 LET Pos=1
870 IF MID$(A$,4,1)=MID$(D$,Pos,1) THEN 900
880 LET Pos=Pos+1
890 GOTO 870
900 LET Longx.=Longx.+(Pos-1)*.2
910 IF INSTR(1,'AEJ',MID$(A$,5,1))=0 THEN 940
920 LET Longx.=Longx.+.2/3.
930 GOTO 960
940 IF INSTR(1,'BCD',MID$(A$,5,1))=0 THEN 960
950 LET Longx.=Longx.+.4/3.
960 RETURN
970 REM
980 REM CALCULATION OF DISTANCE AND AZIMUTH
990 REM
1000 LET F.=(Lat0.+Latx.)*Degrad./2.
1010 LET L.=ABS(Long0.-Longx.)
1020 IF L.<=180. THEN 1035
1030 LET L.=360.-L.
1035 LET L6.=L.
1040 LET L.=L.*L.
1045 LET L7.=L.*L.
1050 LET B3.=(Lat0.-Latx.)*(Lat0.-Latx.)
1055 LET B4.=B3.*B3.
1060 LET N.=COS(F.)*COS(F.)*E1.
1070 LET V.=(1.+N.)*(1.+N.)
1080 LET T.=TAN(F.)*TAN(F.)
1090 LET T4.=T.*T.
1100 LET U.=SQR(1.+N.)/Erade.
1110 LET D3.=SIN(F.)*SIN(F.)
1120 LET D1.=COS(F.)*COS(F.)
1130 LET D2.=D1.*D1.
1140 LET L1.=-N.*(3.*T.+1.+N.+6.*N.*T.)/(24.*R3.*V.)
1150 LET L2.=-N./(12.*R3.)
1160 LET L3.=-N.*(1.+15.*T.)/(1440.*R4.)
1170 LET L4.=N.*(-1.-10.*T.+15.*T4.)/(720.*R4.)
1180 LET L5.=N.*(-3.*T.+T4.)/(240.*R4.)
1200 LET L6.=L6.*SQR(1.+N.)*(L5.*D2.*L7.+L4.*B3.*L.*D1.+L3.*B4.+L2.*L.*D3.+L1.*B3.+1.)
1210 LET B1.=M1.-ATN(Eradp.*TAN(Lat0.*Degrad.)/Erade.)
1220 LET B2.=M1.-ATN(Eradp.*TAN(Latx.*Degrad.)/Erade.)
1250 S.=FNArccos.(COS(B1.)*COS(B2.)+SIN(B1.)*SIN(B2.)*COS(L6.*Degrad.))
1260 LET Q.=(COS(B2.)-COS(B1.)*COS(S.))/(SIN(S.)*SIN(B1.))
1270 IF ABS(Q.)-1.<=0. THEN 1290
1280 LET Q.=SGN(Q.)
1290 Azim.=FNArccos.(Q.)/Degrad.
1300 LET L1.=N.*(T.-(1.+N.+6.*N.*T.))/(24.*R3.*V.)
1310 LET L2.=-N./(12.*R3.)
1320 LET L3.=N.*(1.-T.)/(480.*R4.)
1330 LET L4.=N.*(-1.+2.*T.+15.*T4.)/(720.*R4.)
1340 LET L5.=-N.*(9.*T.-5.*T4.)/(720.*R4.)
1345 LET L8.=L2.*L2.*L7.*D3.*D3.+L1.*L2.*B3.*L.*D3.+L1.*L1.*B4.
1350 LET Dist.=S./(U.*(L8.+L5.*L7.*D2.+L4.*B3.*L.*D1.+L3.*B4.+L2.*L.*D3.+L1.*B3.+1.))
1360 IF Long0.<0. THEN 1410
1370 IF Longx.