home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / misc / miscbas / micromuf.bas next >
BASIC Source File  |  1992-01-01  |  5KB  |  175 lines
  1. 1000 A=100:REM `MICROMUF'
  2. 1010 A=0:N=0:YT=0:XT=0:YR=0:XR=0
  3. 1020 R=0:M=0:X=0:Y=0:LA=0:LS=0:HP=0
  4. 1030 SF=0:FE=0:SE=0:RE=0:CP=0
  5. 1040 K=0:HO=0:VE=O:L=0:XZ=0:MF=0:FF=0
  6. 1050 XH=0:SX=0:WX=0:LH=0:LM=0:AB=O:T=0
  7. 1060 SX=0:WX=0:LH=0:LM=0:AB=0:T=0
  8. 1070 T$="":R$="":A$=""
  9. 1080 P=3.14159265#
  10. 1090 I$="INVALID"
  11. 1100 RD=P/180:D=180/P
  12. 1110 CLS
  13. 1120 PRINT "                    *** MICROMUF ***                       "
  14. 1130 PRINT
  15. 1140 PRINT "THIS PROGRAM CALCULATES THE:"
  16. 1150 PRINT
  17. 1160 PRINT " * M. U. F. (MAXIMUM USABLE FREQUENCY)"
  18. 1170 PRINT
  19. 1180 PRINT " * L. U. F. (LOWEST USABLE  FREQUENCY)"
  20. 1190 PRINT
  21. 1200 PRINT "OF ANY SHORTWAVE SKYWAVE-PATH."
  22. 1210 PRINT :PRINT
  23. 1220 PRINT "CALCULATIONS CAN BE DONE FOR"
  24. 1230 PRINT
  25. 1240 PRINT "ANY MONTH AND SUNSPOT NUMBER."
  26. 1250 PRINT :PRINT
  27. 1260 PRINT "NAME TRANSMITTER LOCATION"
  28. 1270 INPUT T$
  29. 1280 PRINT
  30. 1290 PRINT "TRANSMITTER LONGITUDE"
  31. 1300 PRINT "IN DEGR. (W=+ E=-)";
  32. 1310 INPUT YT
  33. 1320 IF YT<-180 OR YT>180 THEN PRINT I$:GOTO 1310
  34. 1330 PRINT
  35. 1340 PRINT "TRANSMITTER LATITUDE"
  36. 1350 PRINT "IN DEGR. (N=+ S=-)";
  37. 1360 INPUT XT
  38. 1370 IF XT<-90 OR XT>90 THEN PRINT I$:GOTO 1360
  39. 1380 PRINT
  40. 1390 PRINT "NAME RECEIVER LOCATION"
  41. 1400 INPUT R$
  42. 1410 PRINT
  43. 1420 PRINT "RECEIVER LONGITUDE"
  44. 1430 PRINT "IN DEGR. (W=+ E=-)";
  45. 1440 INPUT YR
  46. 1450 IF YR<-180 OR YR>180 THEN PRINT I$:GOTO 1440
  47. 1460 PRINT
  48. 1470 PRINT "RECEIVER LATITUDE"
  49. 1480 PRINT "IN DEGR. (N=+ S=-)";
  50. 1490 INPUT XR
  51. 1500 IF XR<-90 OR XR>90 THEN PRINT I$:GOTO 1490
  52. 1510 PRINT
  53. 1520 PRINT "SUNSPOT NUMBER";
  54. 1530 INPUT R
  55. 1540 IF R<1 OR R>180 THEN PRINT I$:GOTO 1530
  56. 1550 PRINT
  57. 1560 PRINT "MONTH";
  58. 1570 INPUT M
  59. 1580 IF M<1 OR M>12 THEN PRINT I$:GOTO 1570
  60. 1590 REM *** GEOMETRY CALC
  61. 1600 Q=SIN(XT*RD)*SIN(XR*RD)
  62. 1610 X=Q+COS(XT*RD)*COS(XR*RD)*COS(YT*RD-YR*RD)
  63. 1620 LA=-ATN(X/SQR(-X*X+1+1E-12))+(P/2):LA=LA*D
  64. 1630 L=111.1*LA
  65. 1640 Q=(SIN(XR*RD)-SIN(XT*RD)*COS(LA*RD))
  66. 1650 X=Q/COS(XT*RD)/SIN(LA*RD)
  67. 1660 U=-ATN(X/SQR(-X*X+1+1E-12))+(P/2):U=U*D
  68. 1670 IF YT-YR<=0 THEN U=360-U
  69. 1680 IF ABS(YT-YR)>=180 THEN U=360-U
  70. 1690 H=275+R/2
  71. 1700 XS=23.4*COS(30*(M-6.25)*RD)
  72. 1710 N=N+1
  73. 1720 LH=L/N
  74. 1730 WHILE LH>4500
  75. 1731     N=N+1
  76. 1732     LH=L/N
  77. 1735 WEND
  78. 1740 LM=LA/N
  79. 1750 A=ATN((COS(.5*LM*RD)-6367/(H+6367))/SIN(.5*LM*RD))
  80. 1760 A=A*D
  81. 1770 WHILE A<1.5
  82. 1771     N=N+1
  83. 1772     LH=L/N
  84. 1773     WHILE LH>4500
  85. 1774        N=N+1
  86. 1775        LH=L/N
  87. 1776     WEND
  88. 1777     LM=LA/N
  89. 1778     A=ATN((COS(.5*LM*RD)-6367/(H+6367))/SIN(.5*LM*RD))
  90. 1779     A=A*D
  91. 1780 WEND
  92. 1781 CLS
  93. 1790 PRINT "FROM:";T$;" TO:";R$
  94. 1800 PRINT "MONTH:";M;
  95. 1810 PRINT " SSN:";R;:PRINT " DIST:";INT(L+.5);"KM"
  96. 1820 PRINT "AZIM:";INT(U+.5);"DEGR. F-HOPS:";N
  97. 1830 VE=4:HO=1:LOCATE VE,HO
  98. 1840 FOR Q=34 TO 2 STEP -2
  99. 1850 PRINT "I                         I";Q  '25 SPACES
  100. 1860 NEXT Q
  101. 1870 PRINT "---------------------------"  '27 DASHES
  102. 1880 PRINT " 0 2 4 6 8 10  14  18  22 H(UTC)"
  103. 1890 PRINT "      +:MUF  -:LUF"
  104. 1895 VE=4:HO=32:LOCATE VE,HO:PRINT "MHZ"
  105. 1900 FOR T=1 TO 24
  106. 1910 AB=0
  107. 1920 K=.5:GOSUB 2120:GOSUB 2240:MF=FF
  108. 1930 K=N-.5:GOSUB 2120:GOSUB 2240
  109. 1940 IF FF<MF THEN MF=FF
  110. 1950 VE=21-INT(MF/2+.5):HO=T+1
  111. 1960 IF VE<4 THEN VE=4
  112. 1970 LOCATE VE,HO
  113. 1980 PRINT "+"
  114. 1990 FOR K=.25 TO N-.25 STEP .5
  115. 2000 GOSUB 2120
  116. 2010 GOSUB 2490
  117. 2020 AB=AB+LS
  118. 2030 NEXT K
  119. 2040 VE=20-INT(AB+.5)
  120. 2050 IF VE<4 THEN VE=4
  121. 2060 IF VE>20 THEN VE=20
  122. 2070 LOCATE VE,HO
  123. 2080 PRINT "-"
  124. 2090 NEXT T
  125. 2100 VE=23:H0=28:LOCATE VE,HO:PRINT "HIT ANY KEY !"
  126. 2110 QZ$=INKEY$:IF QZ$="" THEN 2110 ELSE GOTO 1000
  127. 2120 REM *** INTERM. LAT. & LONG.
  128. 2130 Q=COS(U*RD)*COS(XT*RD)*SIN(K*LM*RD)
  129. 2140 X=Q+SIN(XT*RD)*COS(K*LM*RD)
  130. 2150 XN=ATN(X/SQR(-X*X+1+1E-12)):XN=XN*D
  131. 2160 Q=(COS(K*LM*RD)-SIN(XT*RD)*SIN(XN*RD))
  132. 2170 X=Q/(COS(XT*RD)*COS(XN*RD))
  133. 2180 YI=-ATN(X/SQR(-X*X+1+1E-12))+(P/2):YI=YI*D
  134. 2190 IF U<180 THEN YI=-YI
  135. 2200 YN=YT+YI
  136. 2210 IF YN>180 THEN YN=YN-360
  137. 2220 IF YN<-180 THEN YN=YN+360
  138. 2230 RETURN
  139. 2240 YZ=YN:REM *** 'MINI-F2' F-LAYER CALC.
  140. 2250 IF YN<-160 THEN YZ=YN+360
  141. 2260 YG=(20-YZ)/50
  142. 2270 ZO=20*YG/(1+YG+YG^2)+5*(1-YG/7)^2
  143. 2280 Z=XN-ZO
  144. 2290 TL=T-YN/15
  145. 2300 IF TL>24 THEN TL=TL-24
  146. 2310 IF TL<0 THEN TL=TL+24
  147. 2320 MH=M
  148. 2330 IF Z>0 THEN 2360
  149. 2340 Z=-Z
  150. 2350 MH=M+6
  151. 2360 XH=COS(30*(MH-6.5)*RD):REM 1 WEEK DELAY ON EQUINOXES
  152. 2370 SX=(ABS(XH)+XH)/2:REM F LAYER LOCAL SUMMER VAR.
  153. 2380 WX=(ABS(XH)-XH)/2:REM F LAYER LOCAL WINTER VAR.
  154. 2390 IF Z>77.5 THEN Z=77.5
  155. 2400 TY=TL
  156. 2410 IF TY<5 THEN TY=TL+24
  157. 2420 YF=(TY-14-SX*2+WX*2-R/175)*(7-SX*3+WX*4-R/(150-WX*75))
  158. 2430 IF ABS(YF)>60 THEN YF=60
  159. 2440 X=(1+R/(175+SX*175))
  160. 2450 F0=6.5*X*COS(YF*RD)*COS((Z-SX*5+WX*5)*RD)^.5
  161. 2460 SF=(1-(COS(A*RD)*6367/(6367+H))^2)^-.5
  162. 2470 FF=F0*SF:REM MUF AT CONTROL POINT
  163. 2480 RETURN
  164. 2490 REM *** E-LAYER & ABSORPT. CALC.
  165. 2500 Q=SIN(XN*RD)*SIN(XS*RD)
  166. 2510 X=Q+COS(XN*RD)*COS(XS*RD)*COS((YN-15*(T-12))*RD)
  167. 2520 XZ=(-ATN(X/SQR(-X*X+1+1E-12))+P/2)*D
  168. 2530 IF XZ>85 GOTO 2560
  169. 2540 FE=3.4*(1+.0016*R)*COS(XZ*RD)^.3
  170. 2550 GOTO 2570
  171. 2560 FE=3.4*(1+.0016*R)*(XZ-80)^-.5
  172. 2570 SE=(1-.965*COS(A*RD)^2)^-.5
  173. 2580 LS=.028*FE^2*SE
  174. 2590 RETURN
  175.