home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Antennas
/
Antennas_CD-ROM_Walnut_Creek_September_1996.iso
/
propdata
/
minimuf
/
minimuf4
/
minimuf4.bas
< prev
next >
Wrap
BASIC Source File
|
1996-06-30
|
12KB
|
292 lines
1 REM MINIMUF4.BAS VERSION 4.1
3 REM ADAPTATION 2.0 FOR IBM PC AT 2325Z 25 JUL 86
5 REM ORIGINAL SOURCE: QST DECEMBER 1982 Pg. 38
6 REM SOURCE OF POLYNOMIAL FLUX TO SUNSPOT # CONVERSION: GILDER, JAMES H.;
7 REM BASIC COMPUTER PROGRAMS IN SCIENCE AND ENGINEERING; HAYDEN 1980
9 REM ADAPTATION BY R. DEAN STRAW, N6BV, JUL 25, 1986
14 REM SAMPLE DRIVER FOR MINIMUF 4.1
15 REM INITIAL DATA
16 CLS:KEY OFF
17 DIM M$(37),A$(4),M(12)
18 FOR I=1 TO 12
19 READ M(I)
20 NEXT I
21 DATA 31,28,31,30,31,30,31,31,30,31,30,31
22 M$="JanFebMarAprMayJunJulAugSepOctNovDec"
23 PI=3.141593: R0=PI/180: P1=2*PI: R1=180/PI: P0=PI/2: X$=STRING$(79,61)
24 DEF FNACS(X)=-ATN(X/SQR(-X*X+1))+1.5708: GOSUB 238: REM SCREEN HEADER
25 PRINT: PRINT "Initialization":PRINT
26 PRINT: PRINT: INPUT "First, Give a Label for Your (Transmitter) Location: ",CS$
27 PRINT :INPUT "Enter Your Latitude, Longitude (``-'' for East & South): ",L9,W9
28 IF L9=>-90 AND L9<=90 THEN 30: PRINT "Invalid Latitude. Must Be in Range (-90 TO +90)"
29 GOTO 27
30 IF -360<=W9 AND W9<=360 THEN 32
31 PRINT "Invalid Longitude. Must Be in Range (-360 TO +360)":GOTO 27
32 CS$="From "+CS$: CLS
33 GOSUB 238: PRINT "Path Options":PRINT
35 PRINT 1,CS$;" To E.Coast USA (Washington, D.C.)"
36 PRINT 2,CS$;" To South America (Asuncion, Paraguay)"
37 PRINT 3,CS$;" To W.Coast SA (Lima, Peru)"
38 PRINT 4,CS$;" To Hawaii (Honolulu)"
39 PRINT 5,CS$;" To Japan (Tokyo)"
40 PRINT 6,CS$;" To Australia (Melbourne)"
41 PRINT 7,CS$;" To S.Asia (Bangkok, Thailand)"
42 PRINT 8,CS$;" To Central Asia (New Delhi, India)"
43 PRINT 9,CS$;" To W.Europe (London, England)"
44 PRINT 10,CS$;" To E.Europe (Kiev, Ukraine)"
45 PRINT 11,CS$;" To USSR (Moscow)"
46 PRINT 12,CS$;" To N.Africa (Cairo, Egypt)"
47 PRINT 13,CS$;" To W.Coast Africa (Liberia)"
48 PRINT 14,CS$;" To E. Coast Africa (Nairobi, Kenya)"
49 PRINT 15,CS$;" To S. Africa (Lusaka, Zambia)"
50 PRINT 16,CS$;" To a Specified Point"
51 PRINT 17,"Between Specified Points":PRINT 18,"Exit Program"
52 PRINT: INPUT "Your Choice: ",CH
53 IF CH<1 OR CH>18 THEN CLS:LOCATE 12,30:PRINT "Bad Choice Number":FOR X=1 TO 2000:NEXT X:CLS:GOTO 31
54 IF CH=18 THEN CLS: SYSTEM
55 GOSUB 238 :REM TO PRINT SCREEN HEADER
56 IF CH=17 THEN GOTO 57 ELSE GOTO 267
57 T$="From Transmitter": R$="To Receiver":PRINT "From Point to Point"
58 PRINT :INPUT "Transmitter Lat,Lon (use ''-'' for East & South): ",L9,W9
59 IF L9=>-90 AND L9<=90 THEN 62
60 PRINT "Invalid Latitude. Must Be in Range (-90 TO +90)"
61 GOTO 58
62 IF -360<=W9 AND W9<=360 THEN 65
63 PRINT "Invalid Longitude. Must Be in Range (-360 TO +360)"
64 GOTO 58
65 PRINT :INPUT "Receiver Lat, Lon (use ''-'' for East & South): ",L2,W2
66 IF -90<=L2 AND L2<=90 THEN 69
67 PRINT "Invalid Latitude. Must Be in Range (-90 TO +90)"
68 GOTO 65
69 IF -360<=W2 AND W2<=360 THEN 72
70 PRINT "Invalid Longitude. Must Be in Range (-360 TO +360)":CLS:GOSUB 238
71 GOTO 65
72 IF CH <>17 THEN PRINT: PRINT CS$ +" "+ R$
73 PRINT: INPUT "Date (Month,Day): ",M0,D6: IF 1<=M0 AND M0<=12 THEN 76
74 PRINT "Invalid Month. Must Be in Range (1 TO 12)":CLS:GOSUB 238
75 GOTO 72
76 IF 1<=D6 AND D6<=M(M0) THEN 80
77 PRINT "Invalid Day. Must Be in Range (1 TO ";M(M0);")"
78 GOTO 72
79 REM SUN SPOT DATA
80 PRINT :INPUT "State Source of Solar Activity - S= Sunspot # F= Solar Flux: ",AN1$
81 IF AN1$="S" OR AN1$="s" THEN 88 ELSE IF AN1$="F" OR AN1$="f" THEN 82 ELSE 80
82 INPUT "Smoothed Mean 10.7cm Solar Flux: ",SF
83 IF SF<65 THEN PRINT "Invalid Flux Number, Must Be Greater Than 65.":GOTO 82
84 IF SF>245 THEN PRINT "Results May Be Inaccurate for Flux Greater Than 245."
85 GOSUB 263 :REM TO ROUTINE FOR FLUX TO SUNSPOT NUMBER CONVERSION
86 PRINT "A Flux of";SF;"Equates to a Sunspot Number of";S9
87 GOTO 93
88 PRINT :INPUT "3-Day Smoothed International Sunspot Number: ",S9
89 IF S9>=0 THEN 93
90 PRINT "Invalid Sunspot Number. Must Be Non-Negative."
91 GOTO 88
92 REM HARD COPY FLAG
93 PRINT :PRINT :INPUT "Do You Want Hard Copy Printout (Y/N)?: ",AN$
94 IF AN$="Y" OR AN$="y" THEN LP=1 ELSE IF AN$="N" OR AN$="n" THEN LP=0 ELSE GOTO 93
95 REM THRESHOLD FLAG
96 PRINT :PRINT :INPUT "Do You Want Flag on MUF Above Given Freq (Y/N)?: ",TA$
97 IF TA$="Y" OR TA$="y" THEN TA=1 ELSE IF TA$="N" OR TA$="n" THEN TA=0 ELSE GOTO 96
98 IF TA=1 THEN INPUT "Specify Freq in MHz: ",TAM
99 CLS
100 A$=MID$(M$,3*M0-2,3)
101 GOSUB 238 :REM TO PRINT SCREEN HEADER
102 PRINT :PRINT "Date: ";A$;D6
103 PRINT :PRINT T$; TAB(43) R$
104 PRINT "Latitude:";L9;" Longitude:";W9; TAB(43) "Latitude:";L2;" Longitude:";W2
105 PRINT :PRINT "Sunspot Number =";S9:GOSUB 300
106 PRINT:PRINT "Range = ";INT(DX+.5);"Statute Miles ";"Bearing = ";INT(B1+.5);"Degrees"
107 PRINT:COLOR 10
108 PRINT " MUF(MHz) UTC";
109 FOR I=5 TO 55 STEP 5
110 COLOR 7:LOCATE ,19+I:PRINT I;
111 NEXT I
112 COLOR 10:PRINT " ======== ===";:COLOR 7
113 LOCATE ,20:PRINT"|====|====|====|====|====|====|====|====|====|====|====|="
114 IF LP=1 THEN GOSUB 245
115 L1=L9*R0: W1=W9*R0: L2=L2*R0: W2=W2*R0: T5=23:GOSUB 146:IF TA=0 THEN D$="*"
116 IF TA=1 THEN IF J9=>TAM THEN D$="*" ELSE D$="."
117 T5=0:PRINT USING " ##.#";J9;:PRINT TAB(15) T5 TAB(20) "|";
118 LOCATE ,20+CINT(J9):COLOR 10:PRINT D$ :COLOR 7
119 IF LP=1 THEN LPRINT USING " ##.#";J9;: LPRINT TAB(15) T5 TAB(20) "|" TAB(20+CINT(J9)) D$
121 FOR T5=0 TO 22
122 GOSUB 146 :REM TO MAIN CALCULATION LOOP
123 REM SCREEN AND PRINTER DATA PRINT
124 IF TA=0 THEN D$="*"
125 IF TA=1 THEN IF J9=>TAM THEN D$="*" ELSE D$="."
126 PRINT USING " ##.#";J9;:PRINT TAB(15) T5+1 TAB(20) "|";
127 LOCATE ,20+CINT(J9):COLOR 10:PRINT D$ :COLOR 7
128 IF LP=1 THEN LPRINT USING " ##.#";J9;:LPRINT TAB(15) T5+1 TAB(20) "|" TAB(20+CINT(J9)) D$
129 NEXT T5
130 REM SCREEN AND PRINTER ENDING
131 LOCATE ,20:PRINT"|====|====|====|====|====|====|====|====|====|====|====|="
132 FOR I=5 TO 55 STEP 5
133 LOCATE ,19+I:PRINT I;
134 NEXT I
135 IF LP=1 THEN 136 ELSE 141
136 LPRINT TAB(20) "|====|====|====|====|====|====|====|====|====|====|====|="
137 FOR I=5 TO 55 STEP 5
138 LPRINT TAB(19+I) I;
139 NEXT I
140 LPRINT CHR$(12)
141 BEEP:BEEP:BEEP:PRINT
142 REM: TO INTRODUCE A DELAY USE -- FOR X=1 TO 4000:NEXT X
143 INPUT "Press Return to Perform Next Case: ",X
144 CLS
145 IF CH=17 THEN GOTO 25 ELSE GOTO 33
146 REM MINIMUF 4.1 CALCULATION LOOP
147 K7=SIN(L1)*SIN(L2)+COS(L1)*COS(L2)*COS(W2-W1)
148 IF K7=>-1 THEN 151
149 K7=-1
150 GOTO 153
151 IF K7<=1 THEN 153
152 K7=1
153 G1=FNACS(K7)
154 K6=1.59*G1
155 IF K6>=1 THEN 157
156 K6=1
157 K5=1/K6
158 J9=100
159 FOR K1=1/(2*K6) TO 1-1/(2*K6) STEP .9999-1/K6
160 IF K5=1 THEN 162
161 K5=.5
162 P=SIN(L2)
163 Q=COS(L2)
164 A=(SIN(L1)-P*COS(G1))/(Q*SIN(G1))
165 B=G1*K1
166 C=P*COS(B)+Q*SIN(B)*A
167 D=(COS(B)-C*P)/(Q*SQR(1-C^2))
168 IF D=>-1 THEN 171
169 D=-1
170 GOTO 173
171 IF D<=1 THEN 173
172 D=1
173 D=FNACS(D)
174 W0=W2+SGN(SIN(W1-W2))*D
175 IF W0=>0 THEN 177
176 W0=W0+P1
177 IF W0<P1 THEN 179
178 W0=W0-P1
179 IF C=>-1 THEN 182
180 C=-1
181 GOTO 184
182 IF C<=1 THEN 184
183 C=1
184 L0=P0-FNACS(C)
185 Y1=.0172*(10+(M0-1)*30.4+D6)
186 Y2=.409*COS(Y1)
187 K8=3.82*W0+12+.13*(SIN(Y1)+1.2*SIN(2*Y1))
188 K8=K8-12*(1+SGN(K8-24))*SGN(ABS(K8-24))
189 IF COS(L0+Y2)>-.26 THEN 198
190 K9=0
191 G0=0
192 M9=2.5*G1*K5
193 IF M9<=P0 THEN 195
194 M9=P0
195 M9=SIN(M9)
196 M9=1+2.5*M9*SQR(M9)
197 GOTO 223
198 K9=(-.26+SIN(Y2)*SIN(L0))/(COS(Y2)*COS(L0)+9.999999E-04)
199 K9=12-ATN(K9/SQR(ABS(1-K9*K9)))*7.639437
200 T=K8-K9/2+12*(1-SGN(K8-K9/2))*SGN(ABS(K8-K9/2))
201 T4=K8+K9/2-12*(1+SGN(K8+K9/2-24))*SGN(ABS(K8+K9/2-24))
202 C0=ABS(COS(L0+Y2))
203 T9=9.7*C0^9.600001
204 IF T9>.1 THEN 206
205 T9=.1
206 M9=2.5*G1*K5
207 IF M9<=P0 THEN 209
208 M9=P0
209 M9=SIN(M9)
210 M9=1+2.5*M9*SQR(M9)
211 IF T4<T THEN 214
212 IF (T5-T)*(T4-T5)>0 THEN 215
213 GOTO 228
214 IF (T5-T4)*(T-T5)>0 THEN 228
215 T6=T5+12*(1+SGN(T-T5))*SGN(ABS(T-T5))
216 G9=PI*(T6-T)/K9
217 G8=PI*T9/K9
218 U=(T-T6)/T9
219 G0=C0*(SIN(G9)+G8*(EXP(U)-COS(G9)))/(1+G8*G8)
220 G7=C0*(G8*(EXP(-K9/T9)+1))*EXP((K9-24)/2)/(1+G8*G8)
221 IF G0=>G7 THEN 223
222 G0=G7
223 G2=(1+S9/250)*M9*SQR(6+58*SQR(G0))
224 G2=G2*(1-.1*EXP((K9-24)/3))
225 G2=G2*(1+(1-SGN(L1)*SGN(L2))*.1)
226 G2=G2*(1-.1*(1+SGN(ABS(SIN(L0))-COS(L0))))
227 GOTO 234
228 T6=T5+12*(1+SGN(T4-T5))*SGN(ABS(T4-T5))
229 G8=PI*T9/K9
230 U=(T4-T6)/2
231 U1=-K9/T9
232 G0=C0*(G8*(EXP(U1)+1))*EXP(U)/(1+G8*G8)
233 GOTO 223
234 IF G2>J9 THEN 236
235 J9=G2
236 NEXT K1
237 RETURN
238 REM SCREEN HEADER
239 CLS: COLOR 0,7
240 PRINT X$
241 PRINT TAB(27) "MINIMUF, Ver. 4.1, by N6BV" STRING$(27,32)
242 COLOR 7,0
243 REM
244 RETURN
245 REM HEADER FOR PRINTER
246 REM
247 LPRINT
248 LPRINT TAB(31) "MINIMUF, Version 4.1"
249 LPRINT TAB(31) "===================="
250 LPRINT TAB(31) " Fine Tuned by N6BV"
251 LPRINT :LPRINT "Date: ";A$;D6
252 LPRINT :LPRINT T$; TAB(43) R$
253 LPRINT "Latitude:";L9;" Longitude:";W9; TAB(43) "Latitude:";L2;" Longitude:";W2
254 LPRINT :LPRINT "Sunspot Number = ";S9:LPRINT
255 LPRINT "Range = ";INT(DX+.5);"Statute Miles "; "Bearing = ";INT(B1+.5);"Degrees"
256 LPRINT: LPRINT " MUF(MHz) UTC";
257 FOR I=5 TO 55 STEP 5
258 LPRINT TAB(19+I) I;
259 NEXT I
260 LPRINT " ======== ===";
261 LPRINT TAB(20) "|====|====|====|====|====|====|====|====|====|====|====|="
262 RETURN
263 REM CALCULATION OF SUNSPOT NUMBER FROM SOLAR FLUX
264 S9=-103.7767+1.797429*SF-(3.384356E-03)*SF^2+(4.525515E-06)*SF^3
265 S9=INT(100*S9+.5)/100
266 RETURN
267 REM PATH OPTION LAT/LON
268 T$=CS$
269 IF CH=1 THEN L2=38:W2=75:R$="To E.Coast USA (Wash.D.C.) ":GOTO 72
270 IF CH=2 THEN L2=-25.3:W2=58:R$="To South America (Asuncion, Paraguay) ":GOTO 72
271 IF CH=3 THEN L2=-12:W2=77:R$="To W.Coast SA (Lima, Peru) ":GOTO 72
272 IF CH=4 THEN L2=22:W2=158:R$="To Hawaii (Honolulu) ":GOTO 72
273 IF CH=5 THEN L2=36:W2=-140:R$="To Japan (Tokyo) ":GOTO 72
274 IF CH=6 THEN L2=-38:W2=-145:R$="To Australia (Melbourne) ":GOTO 72
275 IF CH=7 THEN L2=14:W2=-102:R$="To S.Asia (Bangkok, Thailand) ":GOTO 72
276 IF CH=8 THEN L2=28:W2=-77:R$="To Central Asia (New Delhi, India) ":GOTO 72
277 IF CH=9 THEN L2=51.5:W2=-.1:R$="To W.Europe (London, England) ":GOTO 72
278 IF CH=10 THEN L2=50.5:W2=-31:R$="To E.Europe (Kiev, Ukraine) ":GOTO 72
279 IF CH=11 THEN L2=56:W2=-38:R$="To USSR (Moscow) ":GOTO 72
280 IF CH=12 THEN L2=30:W2=-32:R$="To N.Africa (Cairo, Egypt) ":GOTO 72
281 IF CH=13 THEN L2=8:W2=-10:R$="To W.Coast Africa (Liberia) ":GOTO 72
282 IF CH=14 THEN L2=-2:W2=-37:R$="To E.Coast Africa (Kenya) ":GOTO 72
283 IF CH=15 THEN L2=-15:W2=-28:R$="TO S.Africa (Lusaka, Zambia) ":GOTO 72
284 IF CH=16 THEN R$="To Receiver ": PRINT CS$+" To a Receiver Point" :GOTO 65
300 REM SUBROUTINE TO CALCULATE RANGE AND BEARING
305 Z1=L9*R0:Z2=L2*R0:Z3=W9*R0:Z4=W2*R0
310 R7=SIN(Z1)*SIN(Z2)+COS(Z1)*COS(Z2)*COS(Z4-Z3)
320 IF R7=>-1 THEN 350
330 R7=-1
340 GOTO 370
350 IF R7<=1 THEN 370
360 R7=1
370 R8=FNACS(R7):REM R8 IS DISTANCE IN RADIANS
380 DX=R8*180/PI*69.041:REM RANGE IN STATUTE MILES
390 C1=(SIN(Z2)-SIN(Z1)*R7)/(COS(Z1)*SIN(R8))
400 IF C1>=1 THEN B0=0:GOTO 420 ELSE IF C1<=-1 THEN B0=180/(180/PI):GOTO 420
410 B0=FNACS(C1)
420 B1=B0*180/PI
430 IF SIN(Z3-Z4)<0 THEN B1=360-B1
440 RETURN