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.(Long0.-180.) THEN 1390 1380 GOTO 1430 1390 LET Azim.=360.-Azim. 1400 GOTO 1430 1410 IF Longx.>Long0. AND Longx.<(Long0.+180.) THEN 1430 1420 LET Azim.=360.-Azim. 1430 PRINT USING ' Azimuth: #####.### degrees' Azim. 1441 PRINT USING 'Distance: #####.### km' Dist. 1450 GOTO 400 1460 END 1470 DEF FNArccos.(Y.) 1480 ON ERROR GOTO 1520 1490 RETURN -ATN(Y./SQR(-Y.*Y.+1.))+PI/2 1500 ! > 1520 ! > 1530 RESUME 1500 1540 FNEND