home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1
/
HamRadio.cdr
/
misc
/
ham_grid
/
grid.bas
Wrap
BASIC Source File
|
1987-08-12
|
7KB
|
142 lines
10 ' Maidenhead Grid Square Program de W3IWI -- Posted 8/4/85
20 '
30 ' Following entry is default user's QTH, West Longitude and Latitude
40 W=76.936 : L=39.185 : ' for the W3IWI QTH
50 '
60 ' Initialization Constants:
70 P1=3.1415926535# : P2=P1/180 : E9 = .000001 : I=0 : GOSUB 790
80 '
90 CLS
100 PRINT "******************************************"
110 PRINT "*** ***"
120 PRINT "*** MAIDENHEAD GRID SQUARE LOCATOR ***"
130 PRINT "*** ***"
140 PRINT "*** (c)1984 by Dr. Thomas Clark, W3IWI ***"
150 PRINT "*** ***"
160 PRINT "******************************************"
170 PRINT "*** ***"
180 PRINT "** Microsoft Basic translation by KL7NO **"
190 PRINT "*** ***"
200 PRINT "*** Additional revisions by W3IWI ***"
210 PRINT "*** for ease of use with BASICA on ***"
220 PRINT "*** IBM PC or compatible clones (7/85) ***"
230 PRINT "*** ***"
240 PRINT "******************************************"
250 PRINT "*** ***"
260 PRINT "*** Default W.Long = ";W; TAB(40); "***"
270 PRINT "*** Default Lat = ";L; TAB(40); "***"
280 PRINT "*** Default Grid Sqr= ";G$;TAB(40);"***"
290 PRINT "*** ***"
300 PRINT "******************************************"
310 PRINT
320 ' Loop back here for subsequent entries
330 I=I+1
340 IF I>1 THEN 360
350 PRINT "Coordinates of Home Station" : GOTO 540
360 PRINT : PRINT "Target: C=Coordinates, G=Grid, Q=Quit";TAB(55);"? ";
370 T$=INKEY$ : IF T$="" THEN 370 ELSE PRINT T$
380 IF T$="C" OR T$="c" THEN 530
390 IF T$="G" OR T$="g" THEN 430
400 IF T$="Q" OR T$="q" THEN 1370
410 PRINT "INVALID ENTRY--TRY AGAIN" : GOTO 360
420 '
430 PRINT : PRINT "--------- Grid Square for station #";I;"---------------"
440 PRINT " Enter Grid Square for station #";I;" :";TAB(55); : INPUT G$
450 GOSUB 890 : IF L3=6 THEN 470
460 PRINT "Grid square was padded to middle of cell =";TAB(55);G$
470 GOSUB 1120 : GOSUB 1170
480 PRINT
490 PRINT "Target Coordinates: W. Long. =";TAB(54);W;"Deg. W."
500 PRINT " TAB(5╗╠;"Deg."
510 GOTO 600
520 '
530 PRINT : PRINT "--------- Coordinates of station #";I;"---------------"
540 PRINT " West Longitude (return for default =";W;TAB(48);") = ";TAB(55);
550 INPUT T : IF T <> 0 OR I>1 THEN W=T
560 PRINT " Latitude (return for default =";L;TAB(48);") = ";TAB(55);
570 INPUT T : IF T <> 0 OR I>1 THEN L=T
580 GOSUB 790: PRINT "Grid Square for Long = ";W;" and Lat = ";L;" =";TAB(55);G$
590 IF I=1 THEN 650
600 GOSUB 1220
610 PRINT " Azimuth to ";G$;" =";TAB(54);INT(A*10+.5)/10;" Deg."
620 PRINT " and Range =";TAB(54);INT(R*10+.5)/10;U$
630 GOTO 330
640 '
650 W5=W*P2 : L5=L*P2 : S5=SIN(L5) : C5=COS(L5) : ' To figure Azimuth + range
660 PRINT : PRINT "Range in Km,Miles, or Nautical Miles?"
670 PRINT "Enter K, M, or N";TAB(55);"? ";
680 U$=INKEY$ : IF U$="" THEN 680 ELSE PRINT U$ : PRINT
690 IF U$ < "K" OR U$ > "n" THEN 750 ELSE 700
700 IF U$="K" OR U$="k" THEN 710 ELSE 720
710 U$=" km. " : U=6366.2 : GOTO 330 : 'U is mean earth radius in U$ units
720 IF U$="M" OR U$="m" THEN 730 ELSE 740
730 U$=" Miles" : U=3956.09 : GOTO 330
740 IF U$="N" OR U$="n" THEN 760 ELSE 750
750 PRINT "Invalid Entry---try again" : GOTO 660
760 U$=" N. Mi." : U=60/P2 : GOTO 330
770 '
780 REM -- Grid Square from latitude and longitude
790 W3=180-W : IF W3<0 THEN W3=W3+360
800 W1=INT(W3/20+E9)
810 W2=INT((W3-20*W1)/2+E9)+48 : W1=W1+65
820 W3=INT(24*(W3/2-INT(W3/2)+E9))+97
830 L1=INT((L+90)/10+E9) : L2=INT(L+90+E9-10*L1)
840 L3=INT((L+90-10*L1-L2)*24+E9) : L1=L1+65 : L2=L2+48 : L3=L3+97
850 G$=CHR$(W1)+CHR$(L1)+CHR$(W2)+CHR$(L2)+CHR$(W3)+CHR$(L3) : RETURN
860 '
870 REM -- Routine to clean up grid square entry
880 REM -- Pad grid squaΘf not all 6 characters are given (center is 55ll)
890 L3=LEN(G$) : IF L3>6 THEN 1090
900 IF L3=6 THEN 960
910 IF L3<4 THEN 920 ELSE G$=MID$(G$,1,4)+"ll" : GOTO 960
920 IF L3<2 THEN 1090 ELSE G$=MID$(G$,1,2)+"55ll"
930 '
940 '
950 REM -- Convert 1st 2 characters to upper case, last 2 to lower case
960 IF MID$(G$,1,1) <"a" THEN 970 ELSE MID$(G$,1,1)=CHR$(ASC(MID$(G$,1,1))-32)
970 IF MID$(G$,2,1) <"a" THEN 980 ELSE MID$(G$,2,1)=CHR$(ASC(MID$(G$,2,1))-32)
980 IF MID$(G$,5,1) >"Z" THEN 990 ELSE MID$(G$,5,1)=CHR$(ASC(MID$(G$,5,1))+32)
990 IF MID$(G$,6,1) >"Z" THEN 1020 ELSE MID$(G$,5,1)=CHR$(ASC(MID$(G$,6,1))+32)
1000 '
1010 REM -- Check for valid range of characters
1020 T$=MID$(G$,1,1) : IF T$ < "A" OR T$ > "R" THEN 1090
1030 T$=MID$(G$,2,1) : IF T$ < "A" OR T$ > "S" THEN 1090
1040 T$=MID$(G$,3,1) : IF T$ < "0" OR T$ > "9" THEN 1090
1050 T$=MID$(G$,4,1) : IF T$ < "0" OR T$ > "9" THEN 1090
1060 T$=MID$(G$,5,1) : IF T$ < "a" OR T$ > "x" THEN 1090
1070 T$=MID$(G$,6,1) : IF T$ < "a" OR T$ > "x" THEN 1090
1080 RETURN
1090 PRINT"INVALID GRID SQUARE ";TAB(55);G$ : GOTO 1370
1100 '
1110 REM -- Grid Square to approximate west longitude (middle of cell)
1120 W1=ASC(MID$(G$,1,1))-65 : W2=ASC(MID$(G$,3,1))-48 : W3=ASC(MID$(G$,5,1))-97
1130 W=180-20*W1-2*W2-W3/12-1/24 : IF W<0 THEN W=360+W
1140 RETURN
1150 '
1160 REM -- Grid Square to approximate latitude (middle of cell)
1170 L1=ASC(MID$(G$,2,1))-65 : L2=ASC(MID$(G$,4,1))-48 : L3=ASC(MID$(G$,6,1))-97
1180 L=-90+10*L1+L2+L3/24+1/48
1190 RETURN
1200 '
1210 REM -- Range from "home" to target
1220 W6=W*P2 : L6=L*P2 : S6=SIN(L6) : C6=COS(L6)
1230 C=S5*S6+C5*C6*COS(W6-W5) : IF ABS(C)>1 THEN C=SGN(C)
1240 S=SQR(1-C*C) : X=ATN(S/C) : IF C<0 THEN X=X+P1
1250 R=U*X : IF S<>0 THEN 1290 ELSE A=0
1260 RETURN
1270 '
1280 REM -- Azimuth from "home" to target
1290 C1=(S6-S5*C)/(S*C5) : IF ABS(C1)>1 THEN C1=SGN(C1)
1300 S1=SQR(1-C1*C1) : A=ATN(S1/ABS(C1))/P2 : S3=SIN(W5-W6)
1310 IF S3<0 THEN A=-A
1320 IF C1<0 THEN A=180-A
1330 IF A<0 THEN A=A+360
1340 IF A>=360 THEN A=A-360
1350 RETURN
1360 '
1370 END