home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / tech / david4 / grid.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-24  |  6.3 KB  |  153 lines
  1. 10 ' Maidenhead Grid Square Program de W3IWI -- Posted 8/4/85
  2. 20 '
  3. 30 ' Following entry is default user's QTH, West Longitude and Latitude
  4. 40   W=76.936  :   L=39.185  :  ' for the W3IWI QTH
  5. 50 '
  6. 60 ' Initialization Constants:
  7. 70   P1=3.1415926535# : P2=P1/180 : E9 = .000001 : I=0 : GOSUB 790
  8. 80 '
  9. 90 CLS
  10. 100 PRINT "******************************************"
  11. 110 PRINT "***                                    ***"
  12. 120 PRINT "***   MAIDENHEAD GRID SQUARE LOCATOR   ***"
  13. 130 PRINT "***                                    ***"
  14. 140 PRINT "*** (c)1984 by Dr. Thomas Clark, W3IWI ***"
  15. 150 PRINT "***                                    ***"
  16. 160 PRINT "******************************************"
  17. 170 PRINT "***                                    ***"
  18. 180 PRINT "** Microsoft Basic translation by KL7NO **"
  19. 190 PRINT "***                                    ***"
  20. 200 PRINT "***   Additional revisions by W3IWI    ***"
  21. 210 PRINT "***  for ease of use with BASICA on    ***"
  22. 220 PRINT "*** IBM PC or compatible clones (7/85) ***"
  23. 230 PRINT "***                                    ***"
  24. 240 PRINT "******************************************"
  25. 250 PRINT "***                                    ***"
  26. 260 PRINT "***   Default W.Long  = ";W; TAB(40); "***"
  27. 270 PRINT "***   Default    Lat  = ";L; TAB(40); "***"
  28. 280 PRINT "***   Default Grid Sqr=  ";G$;TAB(40);"***"
  29. 290 PRINT "***                                    ***"
  30. 300 PRINT "******************************************"
  31. 310 PRINT
  32. 320 ' Loop back here for subsequent entries
  33. 330 I=I+1
  34. 340   IF I>1 THEN 360
  35. 350 PRINT "Coordinates of Home Station" : GOTO 540
  36. 360 PRINT : PRINT "Target:  C=Coordinates, G=Grid, Q=Quit";TAB(55);"? ";
  37. 370  T$=INKEY$ : IF T$=""  THEN 370 ELSE PRINT T$
  38. 380   IF T$="C" OR T$="c" THEN 530
  39. 390   IF T$="G" OR T$="g" THEN 430
  40. 400   IF T$="Q" OR T$="q" THEN 1370
  41. 410   PRINT "INVALID ENTRY--TRY AGAIN" : GOTO 360
  42. 420 '
  43. 430 PRINT : PRINT "--------- Grid Square for station #";I;"---------------"
  44. 440  PRINT "   Enter Grid Square for station #";I;" :";TAB(55); : INPUT G$
  45. 450   GOSUB 890 : IF L3=6 THEN 470
  46. 460    PRINT "Grid square was padded to middle of cell =";TAB(55);G$
  47. 470  GOSUB 1120 : GOSUB 1170
  48. 480  PRINT
  49. 490  PRINT "Target Coordinates: W. Long. =";TAB(54);W;"Deg. W."
  50. 500  PRINT "                        Lat. =";TAB(54);L;"Deg."
  51. 510 GOTO 600
  52. 520 '
  53. 530 PRINT : PRINT "--------- Coordinates of station #";I;"---------------"
  54. 540  PRINT " West Longitude (return for default =";W;TAB(48);") = ";TAB(55);
  55. 550   INPUT T : IF T <> 0 OR I>1 THEN W=T
  56. 560  PRINT "       Latitude (return for default =";L;TAB(48);") = ";TAB(55);
  57. 570   INPUT T : IF T <> 0 OR I>1 THEN L=T
  58. 580 GOSUB 790: PRINT "Grid Square for Long = ";W;" and Lat = ";L;" =";TAB(55);G$
  59.  
  60.  
  61. 590  IF I=1 THEN 650
  62. 600   GOSUB 1220
  63. 610   PRINT "           Azimuth to ";G$;" =";TAB(54);INT(A*10+.5)/10;" Deg."
  64. 620   PRINT "                  and Range  =";TAB(54);INT(R*10+.5)/10;U$
  65. 630 GOTO 330
  66. 640 '
  67. 650 W5=W*P2 : L5=L*P2 : S5=SIN(L5) : C5=COS(L5)  : ' To figure Azimuth + range
  68. 660 PRINT : PRINT "Range in Km,Miles, or Nautical Miles?"
  69. 670  PRINT "Enter    K, M,   or   N";TAB(55);"? ";
  70. 680   U$=INKEY$ : IF U$="" THEN 680 ELSE PRINT U$ : PRINT
  71. 690    IF U$ < "K" OR U$ > "n" THEN 750 ELSE 700
  72. 700   IF U$="K" OR U$="k" THEN 710 ELSE 720
  73. 710    U$=" km. " : U=6366.2 : GOTO 330 : 'U is mean earth radius in U$ units
  74. 720   IF U$="M" OR U$="m" THEN 730 ELSE 740
  75. 730    U$=" Miles" : U=3956.09 : GOTO 330
  76. 740   IF U$="N" OR U$="n" THEN 760 ELSE 750
  77. 750    PRINT "Invalid Entry---try again" : GOTO 660
  78. 760    U$=" N. Mi." : U=60/P2 : GOTO 330
  79. 770 '
  80. 780 REM -- Grid Square from latitude and longitude
  81. 790 W3=180-W : IF W3<0 THEN W3=W3+360
  82. 800  W1=INT(W3/20+E9)
  83. 810  W2=INT((W3-20*W1)/2+E9)+48 : W1=W1+65
  84. 820  W3=INT(24*(W3/2-INT(W3/2)+E9))+97
  85. 830 L1=INT((L+90)/10+E9) : L2=INT(L+90+E9-10*L1)
  86. 840  L3=INT((L+90-10*L1-L2)*24+E9) : L1=L1+65 : L2=L2+48 : L3=L3+97
  87. 850 G$=CHR$(W1)+CHR$(L1)+CHR$(W2)+CHR$(L2)+CHR$(W3)+CHR$(L3) : RETURN
  88. 860 '
  89. 870 REM -- Routine to clean up grid square entry
  90. 880 REM -- Pad grid square if not all 6 characters are given (center is 55ll)
  91. 890 L3=LEN(G$) : IF L3>6 THEN 1090
  92. 900  IF L3=6 THEN 960
  93. 910   IF L3<4 THEN 920 ELSE G$=MID$(G$,1,4)+"ll" : GOTO 960
  94. 920 IF L3<2 THEN 1090 ELSE G$=MID$(G$,1,2)+"55ll"
  95. 930 '
  96. 940 '
  97. 950 REM -- Convert 1st 2 characters to upper case, last 2 to lower case
  98. 960  IF MID$(G$,1,1) <"a" THEN  970 ELSE MID$(G$,1,1)=CHR$(ASC(MID$(G$,1,1))-32)
  99.  
  100.  
  101. 970  IF MID$(G$,2,1) <"a" THEN  980 ELSE MID$(G$,2,1)=CHR$(ASC(MID$(G$,2,1))-32)
  102.  
  103.  
  104. 980  IF MID$(G$,5,1) >"Z" THEN  990 ELSE MID$(G$,5,1)=CHR$(ASC(MID$(G$,5,1))+32)
  105.  
  106.  
  107. 990  IF MID$(G$,6,1) >"Z" THEN 1020 ELSE MID$(G$,5,1)=CHR$(ASC(MID$(G$,6,1))+32)
  108.  
  109.  
  110. 1000 '
  111. 1010 REM -- Check for valid range of characters
  112. 1020  T$=MID$(G$,1,1) : IF T$ < "A" OR T$ > "R" THEN 1090
  113. 1030  T$=MID$(G$,2,1) : IF T$ < "A" OR T$ > "S" THEN 1090
  114. 1040  T$=MID$(G$,3,1) : IF T$ < "0" OR T$ > "9" THEN 1090
  115. 1050  T$=MID$(G$,4,1) : IF T$ < "0" OR T$ > "9" THEN 1090
  116. 1060  T$=MID$(G$,5,1) : IF T$ < "a" OR T$ > "x" THEN 1090
  117. 1070  T$=MID$(G$,6,1) : IF T$ < "a" OR T$ > "x" THEN 1090
  118. 1080 RETURN
  119. 1090  PRINT"INVALID GRID SQUARE ";TAB(55);G$ : GOTO 1370
  120. 1100 '
  121. 1110 REM -- Grid Square to approximate west longitude (middle of cell)
  122. 1120 W1=ASC(MID$(G$,1,1))-65 : W2=ASC(MID$(G$,3,1))-48 : W3=ASC(MID$(G$,5,1))-97
  123.  
  124.  
  125. 1130  W=180-20*W1-2*W2-W3/12-1/24 : IF W<0 THEN W=360+W
  126. 1140 RETURN
  127. 1150 '
  128. 1160 REM -- Grid Square to approximate latitude (middle of cell)
  129. 1170 L1=ASC(MID$(G$,2,1))-65 : L2=ASC(MID$(G$,4,1))-48 : L3=ASC(MID$(G$,6,1))-97
  130.  
  131.  
  132. 1180  L=-90+10*L1+L2+L3/24+1/48
  133. 1190 RETURN
  134. 1200 '
  135. 1210 REM -- Range from "home" to target
  136. 1220  W6=W*P2 : L6=L*P2 : S6=SIN(L6) : C6=COS(L6)
  137. 1230  C=S5*S6+C5*C6*COS(W6-W5) : IF ABS(C)>1 THEN C=SGN(C)
  138. 1240  S=SQR(1-C*C) : X=ATN(S/C) : IF C<0 THEN X=X+P1
  139. 1250  R=U*X : IF S<>0 THEN 1290 ELSE A=0
  140. 1260 RETURN
  141. 1270 '
  142. 1280 REM -- Azimuth from "home" to target
  143. 1290  C1=(S6-S5*C)/(S*C5) : IF ABS(C1)>1 THEN C1=SGN(C1)
  144. 1300  S1=SQR(1-C1*C1) : A=ATN(S1/ABS(C1))/P2 : S3=SIN(W5-W6)
  145. 1310   IF S3<0  THEN A=-A
  146. 1320   IF C1<0  THEN A=180-A
  147. 1330   IF A<0   THEN A=A+360
  148. 1340   IF A>=360 THEN A=A-360
  149. 1350 RETURN
  150. 1360 '
  151. 1370 END
  152.  
  153.