[net.sources] MUF prog in basic

jdo743@uiucuxa.CSO.UIUC.EDU (10/05/86)

I have had some requests for the BASIC version of the MUF program I had
posted.  This is it.  Some modifications will have to be made for non-IBM
machines.  The WHILE/WEND loops will have to be taken out.  The variables
VE & HO are screen positioning variables.  1,1 corresponds to the upper left
corner of the screen.  LOCATE VE,HO puts the cursor at the location VE,HO.

Jon Ogden
uiucdcs!uiucuxa!jdo743


1000 A=100:REM `MICROMUF'
1010 A=0:N=0:YT=0:XT=0:YR=0:XR=0
1020 R=0:M=0:X=0:Y=0:LA=0:LS=0:HP=0
1030 SF=0:FE=0:SE=0:RE=0:CP=0
1040 K=0:HO=0:VE=O:L=0:XZ=0:MF=0:FF=0
1050 XH=0:SX=0:WX=0:LH=0:LM=0:AB=O:T=0
1060 SX=0:WX=0:LH=0:LM=0:AB=0:T=0
1070 T$="":R$="":A$=""
1080 P=3.14159265#
1090 I$="INVALID"
1100 RD=P/180:D=180/P
1110 CLS
1120 PRINT "                    *** MICROMUF ***                       "
1130 PRINT
1140 PRINT "THIS PROGRAM CALCULATES THE:"
1150 PRINT
1160 PRINT " * M. U. F. (MAXIMUM USABLE FREQUENCY)"
1170 PRINT
1180 PRINT " * L. U. F. (LOWEST USABLE  FREQUENCY)"
1190 PRINT
1200 PRINT "OF ANY SHORTWAVE SKYWAVE-PATH."
1210 PRINT :PRINT
1220 PRINT "CALCULATIONS CAN BE DONE FOR"
1230 PRINT
1240 PRINT "ANY MONTH AND SUNSPOT NUMBER."
1250 PRINT :PRINT
1260 PRINT "NAME TRANSMITTER LOCATION"
1270 INPUT T$
1280 PRINT
1290 PRINT "TRANSMITTER LONGITUDE"
1300 PRINT "IN DEGR. (W=+ E=-)";
1310 INPUT YT
1320 IF YT<-180 OR YT>180 THEN PRINT I$:GOTO 1310
1330 PRINT
1340 PRINT "TRANSMITTER LATITUDE"
1350 PRINT "IN DEGR. (N=+ S=-)";
1360 INPUT XT
1370 IF XT<-90 OR XT>90 THEN PRINT I$:GOTO 1360
1380 PRINT
1390 PRINT "NAME RECEIVER LOCATION"
1400 INPUT R$
1410 PRINT
1420 PRINT "RECEIVER LONGITUDE"
1430 PRINT "IN DEGR. (W=+ E=-)";
1440 INPUT YR
1450 IF YR<-180 OR YR>180 THEN PRINT I$:GOTO 1440
1460 PRINT
1470 PRINT "RECEIVER LATITUDE"
1480 PRINT "IN DEGR. (N=+ S=-)";
1490 INPUT XR
1500 IF XR<-90 OR XR>90 THEN PRINT I$:GOTO 1490
1510 PRINT
1520 PRINT "SUNSPOT NUMBER";
1530 INPUT R
1540 IF R<1 OR R>180 THEN PRINT I$:GOTO 1530
1550 PRINT
1560 PRINT "MONTH";
1570 INPUT M
1580 IF M<1 OR M>12 THEN PRINT I$:GOTO 1570
1590 REM *** GEOMETRY CALC
1600 Q=SIN(XT*RD)*SIN(XR*RD)
1610 X=Q+COS(XT*RD)*COS(XR*RD)*COS(YT*RD-YR*RD)
1620 LA=-ATN(X/SQR(-X*X+1+1E-12))+(P/2):LA=LA*D
1630 L=111.1*LA
1640 Q=(SIN(XR*RD)-SIN(XT*RD)*COS(LA*RD))
1650 X=Q/COS(XT*RD)/SIN(LA*RD)
1660 U=-ATN(X/SQR(-X*X+1+1E-12))+(P/2):U=U*D
1670 IF YT-YR<=0 THEN U=360-U
1680 IF ABS(YT-YR)>=180 THEN U=360-U
1690 H=275+R/2
1700 XS=23.4*COS(30*(M-6.25)*RD)
1710 N=N+1
1720 LH=L/N
1730 WHILE LH>4500
1731     N=N+1
1732     LH=L/N
1735 WEND
1740 LM=LA/N
1750 A=ATN((COS(.5*LM*RD)-6367/(H+6367))/SIN(.5*LM*RD))
1760 A=A*D
1770 WHILE A<1.5
1771     N=N+1
1772     LH=L/N
1773     WHILE LH>4500
1774        N=N+1
1775        LH=L/N
1776     WEND
1777     LM=LA/N
1778     A=ATN((COS(.5*LM*RD)-6367/(H+6367))/SIN(.5*LM*RD))
1779     A=A*D
1780 WEND
1781 CLS
1790 PRINT "FROM:";T$;" TO:";R$
1800 PRINT "MONTH:";M;
1810 PRINT " SSN:";R;:PRINT " DIST:";INT(L+.5);"KM"
1820 PRINT "AZIM:";INT(U+.5);"DEGR. F-HOPS:";N
1830 VE=4:HO=1:LOCATE VE,HO
1840 FOR Q=34 TO 2 STEP -2
1850 PRINT "I                         I";Q  '25 SPACES
1860 NEXT Q
1870 PRINT "---------------------------"  '27 DASHES
1880 PRINT " 0 2 4 6 8 10  14  18  22 H(UTC)"
1890 PRINT "      +:MUF  -:LUF"
1895 VE=4:HO=32:LOCATE VE,HO:PRINT "MHZ"
1900 FOR T=1 TO 24
1910 AB=0
1920 K=.5:GOSUB 2120:GOSUB 2240:MF=FF
1930 K=N-.5:GOSUB 2120:GOSUB 2240
1940 IF FF<MF THEN MF=FF
1950 VE=21-INT(MF/2+.5):HO=T+1
1960 IF VE<4 THEN VE=4
1970 LOCATE VE,HO
1980 PRINT "+"
1990 FOR K=.25 TO N-.25 STEP .5
2000 GOSUB 2120
2010 GOSUB 2490
2020 AB=AB+LS
2030 NEXT K
2040 VE=20-INT(AB+.5)
2050 IF VE<4 THEN VE=4
2060 IF VE>20 THEN VE=20
2070 LOCATE VE,HO
2080 PRINT "-"
2090 NEXT T
2100 VE=23:H0=28:LOCATE VE,HO:PRINT "HIT ANY KEY !"
2110 QZ$=INKEY$:IF QZ$="" THEN 2110 ELSE GOTO 1000
2120 REM *** INTERM. LAT. & LONG.
2130 Q=COS(U*RD)*COS(XT*RD)*SIN(K*LM*RD)
2140 X=Q+SIN(XT*RD)*COS(K*LM*RD)
2150 XN=ATN(X/SQR(-X*X+1+1E-12)):XN=XN*D
2160 Q=(COS(K*LM*RD)-SIN(XT*RD)*SIN(XN*RD))
2170 X=Q/(COS(XT*RD)*COS(XN*RD))
2180 YI=-ATN(X/SQR(-X*X+1+1E-12))+(P/2):YI=YI*D
2190 IF U<180 THEN YI=-YI
2200 YN=YT+YI
2210 IF YN>180 THEN YN=YN-360
2220 IF YN<-180 THEN YN=YN+360
2230 RETURN
2240 YZ=YN:REM *** 'MINI-F2' F-LAYER CALC.
2250 IF YN<-160 THEN YZ=YN+360
2260 YG=(20-YZ)/50
2270 ZO=20*YG/(1+YG+YG^2)+5*(1-YG/7)^2
2280 Z=XN-ZO
2290 TL=T-YN/15
2300 IF TL>24 THEN TL=TL-24
2310 IF TL<0 THEN TL=TL+24
2320 MH=M
2330 IF Z>0 THEN 2360
2340 Z=-Z
2350 MH=M+6
2360 XH=COS(30*(MH-6.5)*RD):REM 1 WEEK DELAY ON EQUINOXES
2370 SX=(ABS(XH)+XH)/2:REM F LAYER LOCAL SUMMER VAR.
2380 WX=(ABS(XH)-XH)/2:REM F LAYER LOCAL WINTER VAR.
2390 IF Z>77.5 THEN Z=77.5
2400 TY=TL
2410 IF TY<5 THEN TY=TL+24
2420 YF=(TY-14-SX*2+WX*2-R/175)*(7-SX*3+WX*4-R/(150-WX*75))
2430 IF ABS(YF)>60 THEN YF=60
2440 X=(1+R/(175+SX*175))
2450 F0=6.5*X*COS(YF*RD)*COS((Z-SX*5+WX*5)*RD)^.5
2460 SF=(1-(COS(A*RD)*6367/(6367+H))^2)^-.5
2470 FF=F0*SF:REM MUF AT CONTROL POINT
2480 RETURN
2490 REM *** E-LAYER & ABSORPT. CALC.
2500 Q=SIN(XN*RD)*SIN(XS*RD)
2510 X=Q+COS(XN*RD)*COS(XS*RD)*COS((YN-15*(T-12))*RD)
2520 XZ=(-ATN(X/SQR(-X*X+1+1E-12))+P/2)*D
2530 IF XZ>85 GOTO 2560
2540 FE=3.4*(1+.0016*R)*COS(XZ*RD)^.3
2550 GOTO 2570
2560 FE=3.4*(1+.0016*R)*(XZ-80)^-.5
2570 SE=(1-.965*COS(A*RD)^2)^-.5
2580 LS=.028*FE^2*SE
2590 RETURN