home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / misc / mapr86 / mapper86.bas < prev    next >
BASIC Source File  |  1989-01-15  |  39KB  |  709 lines
  1. 100 DEFINT I-N: CALL MY.COLOR( 14, 0)
  2. 110 DIM LEGEND$(10), MENU$(20), MONTH$(12), XDAT(5), YDAT(5), X(1000), Y(1000), XS(400), YS(400), XI(3), XT(3), XU(3), PREFIX$(30), COUNTRY$(30), XLAT(30), XLONG(30)
  3. 120 DIM FREQ(10), WAVE.LEN(10), TX.LOSS(10), RX.LOSS(10), REF.LOSS(10), ABSORB.LOSS(10), PR(10)
  4. 130 DIM GT(10), GR(10), H.TXANT(10), H.RXANT(10), TX.POL$(10), RX.POL$(10), TX.POL%(10), RX.POL%(10)
  5. 140 DIM SHARED NX.BEGIN,NX.END,NY.BEGIN,NY.END,MAX.VERT,SCR.MODE%
  6. 150 DATA Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec
  7. 160 FOR I = 0 TO 11: READ MONTH$(I): NEXT
  8. 170 DATA "    Menu Options     ","                     ","1*-Select DX Prefix  ","2- Specify Country Name","3- Specify Lat/Lon   ","4- Change Sunspot #  "
  9. 180 DATA "5- Select Date/Time  ","6- Use Real Time     ","7- Select Short Path ","8- Select Long  Path ","9- Quit              "
  10. 190 DATA "                     ","   Choose One "
  11. 200 N.MENU = 13: FOR I = 1 TO N.MENU: READ MENU$(I): NEXT I
  12. 210 DATA 3.5,7,10.1,14,18.1,21,24.5,28.5: NFREQ = 8
  13. 220 FOR I = 1 TO NFREQ: READ FREQ(I): WAVE.LEN(I) = 300 / FREQ(I): NEXT I
  14. 230 DATA Prfx,Ctry,Lat/Lon,Dat/Tim,R Time,ShPth,LngPth,ChParams,Quit
  15. 240 FOR I = 1 TO 9: READ LEGEND$(I): NEXT I
  16. 250 '$DYNAMIC
  17. 260 DIM NSTORE1(32500),NSTORE2(32500), ZPREFIX$(500), ZCOUNTRY$(500), ZLAT(500), ZLONG(500)
  18. 270 '$STATIC
  19. 280 DEF FNASIN (X)
  20. 290    IF ABS(X) >= .999999 THEN FNASIN = SGN(X) * 2 * ATN(1): EXIT DEF
  21. 300    FNASIN = ATN(X / SQR(1 - X * X))
  22. 310 END DEF
  23. 320 DEF FNACOS (X)
  24. 330    FNACOS = 2 * ATN(1) - FNASIN(X)
  25. 340 END DEF
  26. 350 DEF FNATN2 (X, Y)
  27. 360    IF ABS(X) < .00001 THEN FNATN2 = SGN(Y) * 2 * ATN(1): EXIT DEF
  28. 370    IF ABS(Y) < .00001 THEN FNATN2 = 2 * ATN(1) * (1 - SGN(X)): EXIT DEF
  29. 380    IF Y >= 0 AND X > 0 THEN FNATN2 = ATN(Y / X): EXIT DEF
  30. 390    IF Y >= 0 AND X < 0 THEN FNATN2 = 2 * ATN(1) - ATN(X / Y): EXIT DEF
  31. 400    IF X > 0 THEN FNATN2 = ATN(Y / X): EXIT DEF
  32. 410    FNATN2 = -2 * ATN(1) - ATN(X / Y)
  33. 420 END DEF
  34. 430  DEF FNT.MOD (T, T0) = T - .5 * T0 * (1 + SGN(T - T0)) * SGN(ABS(T - T0))
  35. 440  DEF FNXFORM (X)
  36. 450      XFORM = X - HOME.LON: IF XFORM > 180 THEN XFORM = XFORM - 360
  37. 460      IF XFORM < -180 THEN XFORM = 360 + XFORM
  38. 470      FNXFORM = XFORM
  39. 480 END DEF
  40. 490 DEF FNDIG$ (X)
  41. 500 KX = X: AA$ = MID$(STR$(KX), 2): FNDIG$ = AA$: IF LEN(AA$) = 1 THEN FNDIG$ = "0" + AA$
  42. 510 END DEF
  43. 520 DEF FNDB (X) = 10 * LOG(X) / LOG(10)
  44. 530 DEF FNDBI (X) = 10 ^ (.1 * X)
  45. 540 DEF FNSUN.SPOT (SF) : REM   CALCULATION OF SUNSPOT NUMBER FROM SOLAR FLUX
  46. 550 IF SF > 0 THEN FNSUN.SPOT = SF: EXIT DEF
  47. 560 SF = ABS(SF)
  48. 570 SSQ = -103.7767 + 1.797429 * SF - (3.384356E-03) * SF ^ 2 + (4.525515E-06) * SF ^ 3
  49. 580 FNSUN.SPOT = INT(100 * SSQ + .5) / 100
  50. 590 END DEF
  51. 600 PI = 4 * ATN(1): CNV = 180 / PI: RE = 6364
  52. 610 T.DRAW = 20
  53. 620 'CALL CLOCKON(0)
  54. 630 ON KEY(1) GOSUB 11000: ON KEY(2) GOSUB 11010: ON KEY(3) GOSUB 11020: ON KEY(4) GOSUB 11030:
  55. 640 ON KEY(5) GOSUB 11040: ON KEY(6) GOSUB 11050: ON KEY(7) GOSUB 11060: ON KEY(8) GOSUB 11070: ON KEY(9) GOSUB 11080
  56. 1000 PRINT : PRINT
  57. 1105 print "                               MAPPER86 "
  58. 1010 PRINT "               DX Mapping and HF Propagation Prediction  Program        "
  59. 1020 PRINT "                         Adapted from MINIMUF 3.5 "
  60. 1030 PRINT "                            by Dennis Murray        "
  61. 1035 print "               for computers without 80x87 Math Coprocessers"
  62. 1040 PRINT : PRINT
  63. 1050 PRINT "          This program is in the Public Domain for non-commercial   "
  64. 1060 PRINT "          use only by anyone who wants to use it or adapt it to"
  65. 1070 PRINT "          suit their needs. The author takes no responsibility for "
  66. 1080 PRINT "          guaranteeing that it will work on your machine, nor for "
  67. 1090 PRINT "          supporting this software. It should work on all PC compatibles"
  68. 1100 PRINT "          with CGA or EGA graphics Cards without a Math Coprocessor."
  69. 1130 PRINT "          This program is designed to be compiled using Microsoft "
  70. 1140 PRINT "          Quick Basic v3.0 in order to speed up the computations for "
  71. 1142 PRINT "          computers without 80x87 Math processors. If you have a math "
  72. 1143 print "          coprocessor, use a Hercules Graphics Adapter, or can stand "
  73. 1144 print "          the slow speed then use the MAPPER87 version of this program."
  74. 1160 PRINT : PRINT
  75. 1170 PRINT "          You are on your own if it doesn't work on your machine!"
  76. 1180 PRINT "                  ( What do you want for free? )"
  77. 1190 PRINT : PRINT "                     Hit any key to proceed"; : A$ = INPUT$(1): CLS
  78. 1500 'READ ATLAS
  79. 1510 PRINT : LOCATE 13, 16, 0: CALL MY.COLOR( 20, 14): PRINT " Fetching DX Atlas  .. Wait a While ";
  80. 1520 OPEN "I", 2, "MAPPER.ATL": K = 0
  81. 1530 IF EOF(2) THEN N.ATL = K: CLOSE 2: GOTO 1600
  82. 1540 K = K + 1: INPUT #2, ZPREFIX$(K), ZLAT(K), ZLONG(K), ZCOUNTRY$(K)
  83. 1550 GOTO 1530
  84. 1600 CALL MY.COLOR( 14, 0): CLS : PRINT : PRINT
  85. 1610 PRINT USING "             ### DX Atlas Entries Loaded"; N.ATL: PRINT
  86. 1620 PRINT
  87. 2000 OPEN "I", 2, "MAPPER.DEF"
  88. 2010 INPUT #2,VIDEO$
  89. 2020 INPUT #2, HOME.LAT, HOME.LON, SSN, T.DRAW
  90. 2030 FOR I = 1 TO NFREQ: INPUT #2, H.TXANT(I), TX.POL$(I), GT(I): NEXT I
  91. 2040 FOR I = 1 TO NFREQ: INPUT #2, H.RXANT(I), RX.POL$(I), GR(I): NEXT I
  92. 2050 INPUT #2, PT, E.MIN: CLOSE 2
  93. 2060 'RENTRY POINT
  94. 2070 CLS 0: CALL MY.COLOR( 14,0)
  95. 2080 PRINT "   Default Values Which Will Be Used Unless Changed"
  96. 2090 PRINT :
  97. 2100 PRINT USING "     1- Sunspot Number = ###        "; SSN
  98. 2110 PRINT USING "     2- Home Latitude/Longitude = ###.# N / ####.# W"; HOME.LAT; -HOME.LON
  99. 2120 PRINT USING "     3- Auto Redraw of Solar Terminator Every ### min"; T.DRAW
  100. 2130 PRINT USING "     4- Home Transmitter Power Output=#### Watts"; PT
  101. 2140 PRINT USING "     5- Minimum Elevation Angle=###.# deg"; E.MIN
  102. 2150 PRINT USING "     6- Graphics Mode &";VIDEO$
  103. 2160 PRINT "     7- Home Antenna .."
  104. 2170 PRINT "Band Freq(MHz) Ht(ft) Pol  Gain(dBi) .. Band Freq(MHz) Ht(ft) Pol  Gain(dBi)"
  105. 2180 FOR I = 1 TO NFREQ / 2
  106. 2190 PRINT USING " ##    ##.#    ###.#  \   \   ###.#      ##    ##.#    ###.#  \   \   ###.#"; I; FREQ(I); H.TXANT(I) * 3.28; TX.POL$(I); GT(I); I + NFREQ / 2; FREQ(I + NFREQ / 2); H.TXANT(I+NFREQ/2)*3.28; TX.POL$(I+NFREQ/2); GT(I+NFREQ/2)
  107. 2200 NEXT I
  108. 2210 PRINT "     8- DX   Antenna .."
  109. 2220 PRINT "Band Freq(MHz) Ht(ft) Pol  Gain(dBi) .. Band Freq(MHz) Ht(ft) Pol  Gain(dBi)"
  110. 2230 FOR I = 1 TO NFREQ / 2
  111. 2240 PRINT USING " ##    ##.#    ###.#  \   \   ###.#      ##    ##.#    ###.#  \   \   ###.#"; I; FREQ(I); H.RXANT(I) * 3.28; RX.POL$(I); GR(I); I + NFREQ / 2; FREQ(I + NFREQ / 2); H.RXANT(I+NFREQ/2)*3.28;RX.POL$(I+NFREQ/2);GR(I+NFREQ/2)
  112. 2250 NEXT I
  113. 2260 PRINT
  114. 2270 PRINT "   Enter (1-8) to change ... Anything else to accept";
  115. 2280 A$ = INPUT$(1): N = VAL(A$): PRINT : PRINT
  116. 2290 IF N = 1 THEN INPUT "Enter New Sunspot Number (negative for Solar Flux)"; SF: SSN = FNSUN.SPOT(SF): CLS : GOTO 2060
  117. 2300 IF N = 3 THEN INPUT "Enter Auto Redraw Interval (Minutes)"; T.DRAW: CLS : GOTO 2060
  118. 2310 IF N = 7 THEN INPUT "Enter Band #,  Home Ant Ht (ft), Pol (H/V), and Gain (dBi)"; I, H.TXANT(I), TX.POL$(I), GT(I): H.TXANT(I) = H.TXANT(I) / 3.28
  119. 2320 IF N = 7 THEN A$ = LEFT$(TX.POL$(I), 1): IF A$ = "H" OR A$ = "h" THEN TX.POL$(I) = "Hor": CLS : GOTO 2060 ELSE TX.POL$(I) = "Vert": CLS : GOTO 2060
  120. 2330 IF N = 8 THEN INPUT "Enter Band #,  DX   Ant Ht (ft), Pol (H/V), and Gain (dBi)"; I, H.RXANT(I), RX.POL$(I), GR(I): H.RXANT(I) = H.RXANT(I) / 3.28
  121. 2340 IF N = 8 THEN A$ = LEFT$(RX.POL$(I), 1): IF A$ = "H" OR A$ = "h" THEN RX.POL$(I) = "Hor": CLS : GOTO 2060 ELSE RX.POL$(I) = "Vert": CLS : GOTO 2060
  122. 2350 IF N = 4 THEN INPUT "Enter Home Transmit Power Output (W)"; PT: CLS : GOTO 2060
  123. 2360 IF N = 5 THEN INPUT "Enter Min Elevation Launch Angle (deg)"; E.MIN: CLS : GOTO 2060
  124. 2370 IF N = 6 THEN
  125. 2380    INPUT "Enter Graphics Type (CGA,EGA,MONO)"; VIDEO$
  126. 2390    CALL UPPER.CASE(VIDEO$): MAP.FLAG%=-1
  127. 2400    CLS : GOTO 2060
  128. 2410 END IF
  129. 2420 IF N <> 2 THEN 3000
  130. 2430 INPUT "Enter Home Lat/Lon (+ For North Lat and West Lon) "; HOME.LAT, HOME.LON: HOME.LON = -HOME.LON
  131. 2440 HOME.LON = HOME.LON MOD 360: IF HOME.LON > 180 THEN HOME.LON = HOME.LON - 360
  132. 2450 IF HOME.LON < -180 THEN HOME.LON = 360 + HOME.LON
  133. 2460 CLS : MAP.FLAG% = -1: GOTO 2060
  134. 3000 OPEN "O", 2, "MAPPER.DEF":
  135. 3010 PRINT #2,VIDEO$
  136. 3020 PRINT #2, HOME.LAT, HOME.LON, SSN, T.DRAW
  137. 3030 FOR I = 1 TO NFREQ: PRINT #2, H.TXANT(I); ",", TX.POL$(I); ",", GT(I): NEXT I
  138. 3040 FOR I = 1 TO NFREQ: PRINT #2, H.RXANT(I); ",", RX.POL$(I); ",", GR(I): NEXT I
  139. 3050 PRINT #2, PT; ",", E.MIN
  140. 3060 CLOSE 2: CLS 0:GOSUB SCRN.MODE
  141. 3070 FOR I = 1 TO NFREQ
  142. 3080 IF LEFT$(TX.POL$(I), 1) = "V" THEN TX.POL%(I) = -1
  143. 3090 IF LEFT$(RX.POL$(I), 1) = "V" THEN RX.POL%(I) = -1
  144. 3100 NEXT I
  145. 3110 ON TIMER(60 * T.DRAW) GOSUB REDRAW
  146. 3120 IF MAP.FLAG% THEN GOSUB LAT.LON.SCRN: GOSUB FETCH.MAP:MAP.FLAG%=0:OP%=1:GOTO RESTORE.SCREEN
  147. 3130 'NSEG = VARSEG(NSTORE1(0)): NOFF = VARPTR(NSTORE1(0))
  148. 3140 CALL PTR86(NSEG,NOFF,VARPTR(NSTORE1(0)) )
  149. 3150 DEF SEG = NSEG: BLOAD "MAPPER1.SCR", NOFF: DEF SEG
  150. 3160 'NSEG = VARSEG(NSTORE2(0)): NOFF = VARPTR(NSTORE2(0))
  151. 3170 CALL PTR86(NSEG,NOFF,VARPTR(NSTORE2(0))  )
  152. 3180 DEF SEG = NSEG: BLOAD "MAPPER2.SCR", NOFF: DEF SEG
  153. 3500 RESTORE.SCREEN:
  154. 3510 TIMER ON
  155. 3520 GOSUB GET.DATE: GOSUB LAT.LON.SCRN
  156. 3530 CLS : IF PAINT.FLAG% THEN PAINT  (0, 0), 0, 7
  157. 3540 GOSUB DRAW.TERMINATOR
  158. 3550 PUT (-180,-90), NSTORE1, OR
  159. 3555 PUT (0,-90), NSTORE2, OR
  160. 3560 GOSUB PAINT.OCEANS
  161. 3570 GOSUB DRAW.LAT.LON
  162. 3580 LOCATE MAX.LINE, 1: FOR I = 1 TO 9: CALL MY.COLOR( 2,0): PRINT " F" + CHR$(48 + I); : CALL MY.COLOR( 14,0): PRINT LEGEND$(I); : NEXT I
  163. 4000 MENU:
  164. 4010 FOR I = 1 TO 9: KEY(I) ON: NEXT I
  165. 4020 A$ = INKEY$: IF A$ = "" THEN 4020
  166. 4030 FOR I = 1 TO 9: KEY(I) OFF: NEXT I
  167. 4040 ON OP% GOTO 4100, 4200, 4300, 4500, 4600, 4700, 4800, 4400, 4900
  168. 4100 'LOCATION BY PREFIX
  169. 4110 GOSUB GET.PREFIX: IF K > 0 THEN GOTO PATH.CALCULATION
  170. 4120 GOSUB DELAY: GOTO MENU
  171. 4200 'LOCATION BY COUNTRY NAME
  172. 4210 GOSUB GET.COUNTRY: IF K > 0 THEN GOTO PATH.CALCULATION
  173. 4220 GOSUB DELAY: GOTO MENU
  174. 4300 'LAT/LON
  175. 4310 GOSUB CLEAR.TEXT: PRINT "Enter DX Lat/Long "
  176. 4320 INPUT XLAT, XLONG: XLONG = -XLONG: K = 1: XLAT(1) = XLAT: XLONG(1) = XLONG
  177. 4330 PREFIX$(1) = "": COUNTRY$(1) = "Lat= " + STR$(XLAT) + " .. Long= " + STR$(-XLONG)
  178. 4340 GOTO 5010
  179. 4400 'NEW SSN
  180. 4405 CLS 0: GOTO 2000
  181. 4410 GOSUB CLEAR.TEXT: INPUT "Enter Sunspot Num "; SSN: GOSUB 9220: GOTO MENU
  182. 4500 'NEW DATE
  183. 4510 TIMER OFF: GOSUB CLEAR.TEXT: GOSUB GET.NEW.DATE: GOTO 3530
  184. 4600 'REAL TIME MODE
  185. 4610 GOTO RESTORE.SCREEN
  186. 4700 'SET SHORT PATH
  187. 4710 PATH% = 0: GOTO MENU:
  188. 4800 'SET LONG PATH
  189. 4810 PATH% = -1: GOTO MENU
  190. 4900 END
  191. 5000 PATH.CALCULATION:
  192. 5010 XLAT = XLAT(K): XLONG = XLONG(K):
  193. 5020 LOCATE 1, 26: PRINT SPACE$(54); : LOCATE 1, 26
  194. 5030 CALL MY.COLOR( 14,0): A$ = LEFT$(" " + PREFIX$(K) + "  " + COUNTRY$(K), 48) + " ": L = LEN(A$): B$ = A$: IF L < 48 THEN B$ = " " + STRING$(47, "*") + " ": MID$(B$, (49 - L) / 2) = A$
  195. 5040 PRINT B$; : EXTRA% = 0
  196. 5050 CALL MINIMUF(HOME.LAT, HOME.LON, XLAT, XLONG, PATH%, M0 + 1, D0, T0, SSN, NHOPS, EXTRA%, F.MUF, F.LUF, E.CUTOFF)
  197. 5060 LOCATE 2, 26: PRINT SPACE$(54): LOCATE 2, 26
  198. 5070 PRINT USING "Fmuf=##.# Fluf=##.# F-Ecof=##.# MHz ## Hops"; F.MUF; F.LUF; E.CUTOFF; NHOPS
  199. 5080 CALL TRANSFORM(XLAT, XLONG, X, Y, -1)
  200. 5090 IF PATH% THEN PATH$ = "Long " ELSE PATH$ = "Short"
  201. 5100 LOCATE 1, 1: PRINT USING "Predicting \   \ Path to"; PATH$
  202. 5110 RNG = SQR(X ^ 2 + Y ^ 2) * PI * RE: IF PATH% THEN RNG = 2 * PI * RE - RNG: X = -X: Y = -Y
  203. 5120 AZIM = FNATN2(Y, X) * CNV
  204. 5130 IF AZIM < 0 THEN AZIM = 360 + AZIM
  205. 5140 LOCATE 2, 1: PRINT SPACE$(24); : LOCATE 2, 1
  206. 5150 PRINT USING "Range=#####km,#####nm"; RNG; RNG / 1.85;
  207. 5160 LOCATE 3, 1: PRINT SPACE$(24); : LOCATE 3, 1
  208. 5170 PRINT USING "Az=#### El=###.# deg"; AZIM; ELEV; : CALL MY.COLOR( 14,0)
  209. 5180 GOSUB PRINT.STRENGTH
  210. 5190 CLAT = COS(XLAT / CNV): SLAT = SIN(XLAT / CNV)
  211. 5200 XLONG = FNXFORM(XLONG)
  212. 5210 CLONG = COS(XLONG / CNV): SLONG = SIN(XLONG / CNV)
  213. 5220 XT(1) = CLAT * CLONG: XT(2) = CLAT * SLONG: XT(3) = SLAT
  214. 5230 XI(1) = COS(HOME.LAT / CNV): XI(2) = 0: XI(3) = SIN(HOME.LAT / CNV)
  215. 5240 IF ERASE.FLAG% THEN NCOLOR = 2: CALL MYLINE(NCOLOR, X(), Y(), IPTS, XDAT(), YDAT())
  216. 5250 IPTS = 101: IF PATH% THEN DPATH = -270 / (CNV * (IPTS - 1)) ELSE DPATH = 90 / (CNV * (IPTS - 1))
  217. 5260 J = 0: FOR JJ = 1 TO IPTS: RHO = COS((JJ - 1) * DPATH): RHO1 = SIN((JJ - 1) * DPATH)
  218. 5270 SUM = 0: FOR K = 0 TO 3: XU(K) = XT(K) * RHO1 + XI(K) * RHO: SUM = SUM + XU(K) ^ 2: NEXT K
  219. 5280 SUM = SQR(SUM): FOR K = 1 TO 3: XU(K) = XU(K) / SUM: NEXT K
  220. 5290 J = J + 1: Y(J) = CNV * ATN(XU(3) / SQR(XU(1) ^ 2 + XU(2) ^ 2))
  221. 5300 XU(1) = XU(1) / COS(Y(J) / CNV): XU(2) = XU(2) / COS(Y(J) / CNV)
  222. 5310 IF XU(1) <> 0 THEN X(J) = CNV * ATN(XU(2) / XU(1)) ELSE X(J) = 90 * SGN(XU(2))
  223. 5320 IF XU(1) < 0 THEN IF X(J) < 0 THEN X(J) = 180 + X(J) ELSE X(J) = -180 + X(J)
  224. 5330 NEXT JJ: ERASE.FLAG% = -1: CALL MYLINE(14, X(), Y(), IPTS, XDAT(), YDAT())
  225. 5340 GOTO MENU
  226. 6000 GET.PREFIX: 'FETCH COUNTRY DATA
  227. 6010 CALL MY.COLOR( 14,0)
  228. 6020 GOSUB CLEAR.TEXT
  229. 6030 INPUT "Enter DX Prefix"; PF$: L2 = LEN(PF$): CALL UPPER.CASE(PF$)
  230. 6040 LOCATE 5, 1: PRINT SPACE$(24); : LOCATE 5, 1: JP = 0
  231. 6050 K = 1
  232. 6060 IF JP > N.ATL THEN GOTO 6120
  233. 6070 JP = JP + 1: PREFIX$(K) = ZPREFIX$(JP): COUNTRY$(K) = ZCOUNTRY$(JP): XLAT(K) = ZLAT(JP): XLONG(K) = ZLONG(JP)
  234. 6080 L1 = LEN(PREFIX$(K)): A$ = PF$: IF L2 > L1 THEN A$ = LEFT$(A$, L1)
  235. 6090 IF INSTR(PREFIX$(K), A$) = 0 THEN 6060
  236. 6100 PRINT USING "## "; K; : PRINT LEFT$(PREFIX$(K) + "  " + COUNTRY$(K), 20): K = K + 1
  237. 6110 IF K < MAX.LINE - 7 THEN 6060
  238. 6120 PRINT : IF K = 1 THEN PRINT PF$ + " Not Found   "; : K = -1: RETURN
  239. 6130 INPUT "Select one "; K
  240. 6140 IF K = 0 THEN K = 1: IF JP = N.ATL THEN PRINT PF$ + " Not Found   "; : K = -1: RETURN ELSE GOSUB CLEAR.TEXT: GOTO 6060
  241. 6150 GOSUB CLEAR.TEXT
  242. 6160 XLONG(K) = -XLONG(K): RETURN
  243. 7000 GET.COUNTRY: 'FETCH COUNTRY DATA
  244. 7010 CALL MY.COLOR( 14,0)
  245. 7020 GOSUB CLEAR.TEXT
  246. 7030 PRINT "Enter Country Name ": INPUT CTY$: L2 = LEN(CTY$): CALL UPPER.CASE(CTY$)
  247. 7040 LOCATE 5, 1: PRINT SPACE$(24); : LOCATE 6, 1: PRINT SPACE$(24); : LOCATE 5, 1: JP = 0
  248. 7050 K = 1
  249. 7060 IF JP > N.ATL THEN GOTO 7130
  250. 7070 JP = JP + 1: PREFIX$(K) = ZPREFIX$(JP): COUNTRY$(K) = ZCOUNTRY$(JP): XLAT(K) = ZLAT(JP): XLONG(K) = ZLONG(JP)
  251. 7080 L1 = LEN(COUNTRY$(K)): A$ = CTY$: IF L2 > L1 THEN A$ = LEFT$(A$, L1)
  252. 7090 COUNTRY$ = COUNTRY$(K): CALL UPPER.CASE(COUNTRY$)
  253. 7100 IF INSTR(COUNTRY$, A$) = 0 THEN 7060
  254. 7110 PRINT USING "## "; K; : PRINT LEFT$(PREFIX$(K) + "  " + COUNTRY$(K), 20): K = K + 1
  255. 7120 IF K < MAX.LINE - 7 THEN 7060
  256. 7130 PRINT : IF K = 1 THEN PRINT CTY$ + " Not Found   "; : K = -1: RETURN
  257. 7140 INPUT "Select one "; K
  258. 7150 IF K = 0 THEN K = 1: IF JP = N.ATL THEN PRINT CTY$ + " Not Found   "; : K = -1: RETURN ELSE GOSUB CLEAR.TEXT: GOTO 7060
  259. 7160 GOSUB CLEAR.TEXT
  260. 7170 XLONG(K) = -XLONG(K): RETURN
  261. 8000 PAINT.OCEANS: 'PAINT OCEANS
  262. 8010 IF NOT PAINT.FLAG% THEN RETURN
  263. 8020 NCOLOR = 7
  264. 8030 PAINT (FNXFORM(6), 0), 1, 7        'PAINT OCEANS BLUE
  265. 8040 PAINT (FNXFORM(45), -5), 1, 7      'PAINT OCEANS BLUE
  266. 8050 PAINT (FNXFORM(60), 0), 1, 7       'PAINT OCEANS BLUE
  267. 8060 PAINT (FNXFORM(75), 0), 1, 7       'PAINT OCEANS BLUE
  268. 8070 PAINT (FNXFORM(90), 0), 1, 7       'PAINT OCEANS BLUE
  269. 8080 PAINT (FNXFORM(105), -15), 1, 7    'PAINT OCEANS BLUE
  270. 8090 PAINT (FNXFORM(120), -15), 1, 7    'PAINT OCEANS BLUE
  271. 8100 PAINT (FNXFORM(135), 15), 1, 7     'PAINT OCEANS BLUE
  272. 8110 PAINT (FNXFORM(150), 0), 1, 7      'PAINT OCEANS BLUE
  273. 8120 PAINT (FNXFORM(180), 88), 1, 7     'PAINT OCEANS BLUE
  274. 8130 PAINT (FNXFORM(90), 88), 1, 7      'PAINT OCEANS BLUE
  275. 8140 PAINT (FNXFORM(0), 88), 1, 7       'PAINT OCEANS BLUE
  276. 8150 PAINT (FNXFORM(-90), 88), 1, 7     'PAINT OCEANS BLUE
  277. 8160 PAINT (FNXFORM(-180), 88), 1, 7    'PAINT OCEANS BLUE
  278. 8170 PAINT (FNXFORM(165), 0), 1, 7      'PAINT OCEANS BLUE
  279. 8180 PAINT (FNXFORM(180), 0), 1, 7      'PAINT OCEANS BLUE
  280. 8190 PAINT (FNXFORM(-165), 0), 1, 7     'PAINT OCEANS BLUE
  281. 8200 PAINT (FNXFORM(-150), 0), 1, 7     'PAINT OCEANS BLUE
  282. 8210 PAINT (FNXFORM(-135), 0), 1, 7     'PAINT OCEANS BLUE
  283. 8220 PAINT (FNXFORM(-120), 0), 1, 7     'PAINT OCEANS BLUE
  284. 8230 PAINT (FNXFORM(-105), 0), 1, 7     'PAINT OCEANS BLUE
  285. 8240 PAINT (FNXFORM(-90), 0), 1, 7      'PAINT OCEANS BLUE
  286. 8250 PAINT (FNXFORM(-45), 5), 1, 7      'PAINT OCEANS BLUE
  287. 8260 PAINT (FNXFORM(-30), 0), 1, 7      'PAINT OCEANS BLUE
  288. 8270 PAINT (FNXFORM(-15), 0), 1, 7      'PAINT OCEANS BLUE
  289. 8280 PAINT (FNXFORM(58), -5), 1, 7      'PAINT OCEANS BLUE
  290. 8290 PAINT (FNXFORM(-124), 34), 1, 7    'PAINT OCEANS BLUE
  291. 8300 PAINT (FNXFORM(-70), 32), 1, 7     'PAINT OCEANS BLUE
  292. 8310 PAINT (FNXFORM(5), 40), 1, 7       'PAINT MED SEA BLUE
  293. 8320 PAINT (FNXFORM(-95), 45), 2, 7     'PAINT USA YELLOW
  294. 8330 PAINT (FNXFORM(-120), 42), 2, 7    'PAINT USA YELLOW
  295. 8340 PAINT (FNXFORM(-76), 42), 2, 7     'PAINT USA YELLOW
  296. 8350 PAINT (FNXFORM(-150), 65), 2, 7    'PAINT ALASKA YELLOW
  297. 8360 PAINT (FNXFORM(51.5), 43), 1, 7    'CASPIAN SEA
  298. 8370 PAINT (FNXFORM(-90), 60), 1, 7     'HUDSONS BAY
  299. 8380 PAINT (FNXFORM(-90), 23), 1, 7     'GULF OF MEXICO
  300. 8390 RETURN
  301. 8400 DRAW.LAT.LON: 'DRAW LAT/LON LINES
  302. 8410 FOR XLAT = -90 TO 90 STEP 30
  303. 8420 LINE (-180, XLAT)-(180, XLAT), 6: NEXT
  304. 8430 FOR XLON = -180 TO 180 STEP 60
  305. 8440 LINE (XLON, -90)-(XLON, 90), 6: NEXT
  306. 8450 RETURN
  307. 9000 DRAW.TERMINATOR: 'CALCULATE TERMINATOR
  308. 9010 M0 = VAL(D$) - 1: D0 = VAL(MID$(D$, 4)): T0 = VAL(T$) + VAL(MID$(T$, 4)) / 60
  309. 9020 D0$ = FNDIG$(D0): H0$ = FNDIG$(INT(T0)): M0$ = FNDIG$(60 * (T0 - INT(T0)))
  310. 9030 YR.ANG = .0172 * (10 + 30.4 * M0 + D0): TILT = -.409 * COS(YR.ANG)
  311. 9040 T.NOON = 12 + .13 * SIN(YR.ANG) + .156 * SIN(2 * YR.ANG)
  312. 9050 IF M0 + 1 >= 4 AND M0 + 1 <= 10 THEN T.NOON = T.NOON + 1'DAYLIGHT SAVINGS TIME
  313. 9060 DT = -2 * PI * (T0 - T.NOON) / 24 + HOME.LON / CNV
  314. 9070 CP = COS(TILT): SP = SIN(TILT): CD = COS(DT): SD = SIN(DT)
  315. 9080 LL = 0: FOR L = 1 TO 363: XL = L: CL = COS(XL / CNV): SL = SIN(XL / CNV)
  316. 9090 X1 = -(SP * CD * CL + SD * SL)
  317. 9100 Y1 = -(SP * SD * CL - CD * SL)
  318. 9110 Z1 = CP * CL
  319. 9120 LL = LL + 1: XS(LL) = CNV * FNASIN(Z1): YS0 = CNV * FNATN2(X1, Y1): YS(LL) = YS0 - HOME.LON
  320. 9130 YSS = 360 * SGN(YS(LL)): IF ABS(YS(LL)) > 180 THEN YS(LL) = YS(LL) - YSS
  321. 9140 IF LL > 1 AND ABS(YS(LL) - YS(LL - 1)) > 60 THEN GOSUB 9260
  322. 9150 NEXT L
  323. 9160 CALL MYLINE(7, YS(), XS(), LL, XDAT(), YDAT())
  324. 9170 X1 = CP * CD: Y1 = CP * SD: Z1 = -SP
  325. 9180 X2 = CNV * FNASIN(Z1): Y2 = CNV * FNATN2(X1, Y1) - HOME.LON
  326. 9190 IF ABS(Y2) > 180 THEN Y2 = Y2 - 360 * SGN(Y2)
  327. 9200 IF ABS(Y2) > 178 THEN Y2 = 178 * SGN(Y2)
  328. 9205 LINE (-179.5, -89.5)-(179.5, 89.5), 7, B
  329. 9210 IF PAINT.FLAG% THEN PAINT  (Y2, X2), 4, 7
  330. 9220 CALL MY.COLOR( 14,0): LOCATE 3, 1: PRINT SPACE$(79); : LOCATE 3, 26:
  331. 9230 PRINT USING "\\ \  \ \\:\\ Local .. Sunspot Number = ####"; D0$; MONTH$(M0); H0$; M0$; SSN;
  332. 9240 CALL MY.COLOR( 14,0)
  333. 9250 RETURN
  334. 9260 YS = YS(LL): YSS = 185 * SGN(YS(LL - 1)): YS(LL) = YSS: CALL MYLINE(7, YS(), XS(), LL, XDAT(), YDAT())
  335. 9270 YS(1) = 185 * SGN(YS): YS(2) = YS:
  336. 9280 XS(1) = XS(LL): XS(2) = XS(LL): LL = 2: RETURN
  337. 10000 SUB TRANSFORM (X0, Y0, X2, Y2, POLAR%) STATIC
  338. 10010  STATIC CT0, ST0, NFLAG
  339. 10020 SHARED CNV, PI, HOME.LAT, HOME.LON
  340. 10030  IF NOT NFLAG THEN GOTO INITIALIZE
  341. 10040 NORMAL:
  342. 10050  X = X0: Y = Y0
  343. 10060  Y = FNXFORM(Y): IF NOT POLAR% THEN X2 = X: Y2 = Y: EXIT SUB
  344. 10070  CT = COS(X / CNV): ST = SIN(X / CNV): CP = COS(Y / CNV): SP = SIN(Y / CNV)
  345. 10080  X1 = CT0 * ST - ST0 * CT * CP
  346. 10090  Y1 = CT * SP: Z1 = ST0 * ST + CT0 * CT * CP
  347. 10100  LAM! = FNACOS(Z1): PSI = FNATN2(X1, Y1)
  348. 10110  R = LAM! / PI: X2 = R * SIN(PSI): Y2 = R * COS(PSI)
  349. 10120  EXIT SUB
  350. 10130 INITIALIZE:
  351. 10140  CT0 = COS(HOME.LAT / CNV): ST0 = SIN(HOME.LAT / CNV)
  352. 10150  NFLAG = -1: GOTO NORMAL
  353. 10160 END SUB
  354. 11000 OP% = 1: RETURN 4030
  355. 11010 OP% = 2: RETURN 4030
  356. 11020 OP% = 3: RETURN 4030
  357. 11030 OP% = 4: RETURN 4030
  358. 11040 OP% = 5: RETURN 4030
  359. 11050 OP% = 6: RETURN 4030
  360. 11060 OP% = 7: RETURN 4030
  361. 11070 OP% = 8: RETURN 4030
  362. 11080 OP% = 9: RETURN 4030
  363. 12000 FETCH.MAP: 'WORLD MAP DATA INPUT
  364. 12010 OPEN "I", 1, "WORLDMAP.DAT":
  365. 12020 INPUT #1, X, Y: J = 1
  366. 12030 I = 0
  367. 12040 INPUT #1, X, Y: J = J + 1: Y = FNXFORM(Y)
  368. 12050 IF ABS(X) > 900 THEN CLOSE : GOTO 12120
  369. 12060 IF ABS(X) > 91 THEN GOSUB DRAW.LINE: GOTO 12030
  370. 12070 IF ABS(X - Y(I)) > 20 THEN GOSUB DRAW.LINE: I = 0: GOTO 12100
  371. 12080 IF ABS(Y - X(I)) > 20 AND ABS(X(I)) < 170 THEN GOSUB DRAW.LINE: I = 0: GOTO 12100
  372. 12090 IF ABS(Y - X(I)) > 20 THEN I = I + 1: XSS = X(I - 1): X(I) = 181 * SGN(XSS): Y(I) = X: GOSUB DRAW.LINE: Y(1) = X: XSS = X(I - 1): X(1) = -181 * SGN(XSS): I = 1
  373. 12100 I = I + 1: Y(I) = X: X(I) = Y
  374. 12110 GOTO 12040
  375. 12120 GET (-180, -90)-(0, 89), NSTORE1
  376. 12130 'NSEG = VARSEG(NSTORE1(0)): NOFF = VARPTR(NSTORE1(0))
  377. 12140 CALL PTR86(NSEG,NOFF,VARPTR(NSTORE1(0)) )
  378. 12150 DEF SEG = NSEG: BSAVE "MAPPER1.SCR", NOFF, 65000!: DEF SEG
  379. 12160 GET (0, -90)-(179, 89), NSTORE2
  380. 12170 'NSEG = VARSEG(NSTORE2(0)): NOFF = VARPTR(NSTORE2(0))
  381. 12180 CALL PTR86(NSEG,NOFF,VARPTR(NSTORE2(0)))
  382. 12190 DEF SEG = NSEG: BSAVE "MAPPER2.SCR", NOFF, 65000!: DEF SEG
  383. 12200 RETURN
  384. 13000 LAT.LON.SCRN:
  385. 13020 XBEGIN = -180: XEND = 180: YBEGIN = -90: YEND = 90
  386. 13030 CALL SCALE(XBEGIN, XEND, YBEGIN, YEND, XDAT(), YDAT())
  387. 13040 NCOLOR = 7: XTIC = 30: YTIC = 15
  388. 13050 CALL AXES(NCOLOR, NX.BEGIN, NX.END, NY.BEGIN, NY.END, XDAT(), YDAT(), XTIC, YTIC)
  389. 13060 LINE (-179.5, -89.5)-(179.5, 89.5), 7, B: CALL MY.COLOR( 14,0)
  390. 13070 RETURN
  391. 14000 REDRAW:
  392. 14010 GOSUB GET.DATE: GOSUB LAT.LON.SCRN
  393. 14020 CLS : IF PAINT.FLAG% THEN PAINT  (0, 0), 0, 7
  394. 14030 GOSUB DRAW.TERMINATOR
  395. 14040 PUT (-180, -90), NSTORE1, OR
  396. 14045 PUT (0, -90), NSTORE2, OR
  397. 14050 GOSUB PAINT.OCEANS
  398. 14060 GOSUB DRAW.LAT.LON
  399. 14070 TIMER ON
  400. 14080 RETURN
  401. 15000 GET.NEW.DATE: 'ENTER NEW DATE AND TIME
  402. 15010 INPUT "Date (MM-DD) "; D$
  403. 15020 INPUT "Time (HH:MM) "; T$
  404. 15030 IF D$ = "" THEN D$ = DATE$
  405. 15040 IF T$ = "" THEN T$ = TIME$
  406. 15050 RETURN
  407. 16000 GET.DATE: D$ = DATE$: T$ = TIME$
  408. 16010 RETURN
  409. 17000 DRAW.LINE: CALL MYLINE(NCOLOR, X(), Y(), I, XDAT(), YDAT()): CALL MY.COLOR( 14,0): LOCATE 1, 1: PRINT "RECORD "; JJ, J; : 'A$=INPUT$(1)
  410. 17010 JJ = J: RETURN
  411. 18000 CLEAR.TEXT: FOR J = 5 TO MAX.LINE - 1: LOCATE J, 1: PRINT SPACE$(24); : NEXT J: LOCATE 5, 1: RETURN
  412. 19000 DELAY:
  413. 19010 FOR KK = 1 TO 10000: NEXT KK: RETURN
  414. 20000 PRINT.STRENGTH:
  415. 20010 LOCATE 5, 1: CALL MY.COLOR( 14,0)
  416. 20020 PRINT "Signal Predictions (dB)": PRINT : PRINT "Freq  Lref  Labs Prcv": PRINT "       Ltx   Lrx  "
  417. 20030 S.COUNT% = 0: PR.BEST = -1000: N.BEST = 1: NO.PATH% = -1: FOR I = NFREQ TO 1 STEP -1: IF FREQ(I) < 1.2 * F.MUF AND PR(I) > PR.BEST THEN PR.BEST = PR(I): N.BEST = I
  418. 20040 IF S.COUNT% >= 7 THEN 20070
  419. 20050 IF PR(I) > -20 AND FREQ(I) > .8 * F.LUF AND FREQ(I) < 1.2 * F.MUF THEN NO.PATH% = 0: S.COUNT% = S.COUNT% + 1: PRINT USING "##.# ###.# ###.# #### "; FREQ(I); -REF.LOSS(I); ABSORB.LOSS(I); PR(I)
  420. 20060 IF PR(I) > -20 AND FREQ(I) > .8 * F.LUF AND FREQ(I) < 1.2 * F.MUF THEN NO.PATH% = 0: PRINT USING "     ###.# ###.#      "; -TX.LOSS(I); -RX.LOSS(I)
  421. 20070 NEXT I: I = N.BEST
  422. 20080 IF NO.PATH% THEN PRINT USING "##.# ###.# ###.# #### "; FREQ(I); -REF.LOSS(I); ABSORB.LOSS(I); PR(I)
  423. 20090 IF NO.PATH% THEN PRINT USING "     ###.# ###.#      "; -TX.LOSS(I); -RX.LOSS(I)
  424. 20100 IF NO.PATH% THEN PRINT : PRINT "No Feasible Freq"
  425. 20110 IF NO.PATH% THEN PRINT "Best of Bad Lot is Shown"
  426. 20120 RETURN
  427. 22000 SCRN.MODE:
  428. 22010 IF VIDEO$="VGA" THEN
  429. 22020    SCR.MODE%=12
  430. 22030 ELSEIF VIDEO$="EGA" THEN
  431. 22040    SCR.MODE%=9
  432. 22050 ELSEIF VIDEO$="MCGA" THEN
  433. 22060    SCR.MODE%=11
  434. 22070 ELSEIF VIDEO$="CGA" THEN
  435. 22080    SCR.MODE%=2
  436. 22090 ELSEIF VIDEO$="HERC" THEN
  437. 22100    SCR.MODE%=3
  438. 22110 ELSEIF VIDEO$="MONO" THEN
  439. 22120    SCR.MODE%=10
  440. 22130 END IF
  441. 22140 IF SCR.MODE%=12 THEN
  442. 22150    SCREEN SCR.MODE%:RESTORE 23010:READ MAX.LINE,MAX.VERT,NX.BEGIN,NX.END,NY.BEGIN,NY.END,PAINT.FLAG%
  443. 22160 ELSEIF SCR.MODE%=9 THEN
  444. 22170    SCREEN SCR.MODE%:RESTORE 23020:READ MAX.LINE,MAX.VERT,NX.BEGIN,NX.END,NY.BEGIN,NY.END,PAINT.FLAG%
  445. 22180 ELSEIF SCR.MODE%=11 THEN
  446. 22190    SCREEN SCR.MODE%:RESTORE 23030:READ MAX.LINE,MAX.VERT,NX.BEGIN,NX.END,NY.BEGIN,NY.END,PAINT.FLAG%
  447. 22200 ELSEIF SCR.MODE%=2 THEN
  448. 22210    SCREEN SCR.MODE%:RESTORE 23040:READ MAX.LINE,MAX.VERT,NX.BEGIN,NX.END,NY.BEGIN,NY.END,PAINT.FLAG%
  449. 22220 ELSEIF SCR.MODE%=10 THEN
  450. 22230    SCREEN SCR.MODE%:RESTORE 23050:READ MAX.LINE,MAX.VERT,NX.BEGIN,NX.END,NY.BEGIN,NY.END,PAINT.FLAG%
  451. 22240 ELSEIF SCR.MODE%=3 THEN
  452. 22250    SCREEN SCR.MODE%:RESTORE 23060:READ MAX.LINE,MAX.VERT,NX.BEGIN,NX.END,NY.BEGIN,NY.END,PAINT.FLAG%
  453. 22260 END IF
  454. 22270 RETURN
  455. 23000 'GRAPHICS PARAMETERS
  456. 23010  DATA 30,479,200,600,20,400,-1 :  'VGA
  457. 23020  DATA 25,349,200,600,20,300,-1 :  'EGA
  458. 23030  DATA 30,479,200,600,20,400, 0 :  'MCGA
  459. 23040  DATA 25,199,200,600,10,175, 0 :  'CGA
  460. 23050  DATA 25,349,200,600,20,300, 0 :  'EGA-MONO
  461. 23060  DATA 25,347,225,675,20,300, 0 :  'HERCULES
  462. 35000 SUB REFLECT (ELEV, WAVE.LEN, SEA%, RMAGV, VPHASE, RMAGH, HPHASE, REFLECT.LOSS) STATIC
  463. 35010 'REFLECTION COEFFICIENT CALCULATION
  464. 35020 SHARED CNV, PI
  465. 35030 IF SEA% THEN ER = 80: EI = -60 * WAVE.LEN * 4: DH = 4 ELSE ER = 15: EI = -60 * WAVE.LEN * .01: DH = 10
  466. 35040 RHO = EXP(-2 * (2 * PI * DH * SIN(ELEV / CNV) / WAVE.LEN) ^ 2)
  467. 35050 CA = COS(ELEV / CNV) ^ 2: SA = SIN(ELEV / CNV): SQ1 = ER - CA: PQ1 = .5 * ATN(EI / SQ1): SMAG = SQR(SQ1 ^ 2 + EI ^ 2)
  468. 35060 SMAG = SQR(SMAG): SQ1 = SMAG * COS(PQ1): SQ2 = SMAG * SIN(PQ1):
  469. 35070 DENH = (SQR((SA + SQ1) ^ 2 + SQ2 ^ 2)): PHASE1 = SQ2: PHASE2 = SA + SQ1: GOSUB 35150: HPHASE = PHASE
  470. 35080 NUMH! = (SQR((SA - SQ1) ^ 2 + SQ2 ^ 2)): PHASE1 = -SQ2: PHASE2 = SA - SQ1: GOSUB 35150: HPHASE1 = PHASE
  471. 35090 RMAGH = NUMH! / DENH: HPHASE = HPHASE1 - HPHASE
  472. 35100 DENV = SQR((SA * ER + SQ1) ^ 2 + (EI * SA + SQ2) ^ 2): PHASE1 = (EI * SA + SQ2): PHASE2 = (ER * SA + SQ1): GOSUB 35150: VPHASE = PHASE
  473. 35110 NUMV! = SQR((SA * ER - SQ1) ^ 2 + (EI * SA - SQ2) ^ 2): PHASE1 = (EI * SA - SQ2): PHASE2 = (ER * SA - SQ1): GOSUB 35150: VPHASE1 = PHASE
  474. 35120 RMAGV = NUMV! / DENV: VPHASE = VPHASE1 - VPHASE
  475. 35130 REFLECT.LOSS = FNDB(.5 * (RMAGH ^ 2 + RMAGV ^ 2) * RHO ^ 2)
  476. 35140 EXIT SUB
  477. 35150 '4 QUADRANT ARC TANGENT
  478. 35160 IF PHASE2 > 0 THEN PHASE = ATN(PHASE1 / PHASE2): RETURN
  479. 35170 IF PHASE1 < 0 THEN PHASE = -PI + ATN(PHASE1 / PHASE2) ELSE PHASE = PI + ATN(PHASE1 / PHASE2)
  480. 35180 RETURN
  481. 35190 END SUB
  482. 36000 SUB MULTIPATH (ELEV, WAVE.LEN, H.ANTENNA, XMULTV, XMULTH) STATIC
  483. 36010 ' MULTIPATH CALCULATION
  484. 36020 SHARED CNV, PI
  485. 36030 CALL REFLECT(ELEV, WAVE.LEN, 0, RMAGV, VPHASE, RMAGH, HPHASE, REFLECT.LOSS)
  486. 36040 ALPHAV = VPHASE - 4 * PI * H.ANTENNA * SIN(ELEV / CNV) / WAVE.LEN: XMULTV = FNDB((1 + RMAGV * COS(ALPHAV)) ^ 2 + (RMAGV * SIN(ALPHAV)) ^ 2)
  487. 36050 ALPHAH = HPHASE - 4 * PI * H.ANTENNA * SIN(ELEV / CNV) / WAVE.LEN: XMULTH = FNDB((1 + RMAGH * COS(ALPHAH)) ^ 2 + (RMAGH * SIN(ALPHAH)) ^ 2)
  488. 36060 XMULT = FNDB(.5 * (FNDBI(XMULTV) + FNDBI(XMULTH)))
  489. 36070 END SUB
  490. 39000 SUB MINIMUF (TLAT, TLON, RLAT, RLON, LPATH%, MONTH, DAY, TIME, SSN, NHOPS, EXTRA.HOPS%, F.MUF, F.LUF, E.CUTOFF) STATIC
  491. 39010 WIDTH LPRINT 128
  492. 39020 DIM M$(37), A$(4), M(12)
  493. 39030 SHARED H.TXANT(), H.RXANT(), TX.POL%(), RX.POL%(), FREQ(), WAVE.LEN(), NFREQ, TX.LOSS(), RX.LOSS(), REF.LOSS(), ABSORB.LOSS(), PT, GT(), GR(), PR(), E.MIN, ELEV
  494. 39040 RE = 6364: PI = 3.141593: RPD = PI / 180: PI2 = 2 * PI: CNV = 180 / PI: PI.D2 = PI / 2: X$ = STRING$(79, 61)
  495. 39045 HEIGHT.F2 = 300: HEIGHT.E = 110: HEIGHT.D = 90: POL.LAT = 78.3 / CNV: POL.LON = 69 / CNV
  496. 39050 GMT = TIME - TLON / 15: GMT = FNT.MOD(GMT, 24)
  497. 39060 T.LAT = TLAT * RPD: T.LON = -TLON * RPD: R.LAT = RLAT * RPD: R.LON = -RLON * RPD:
  498. 39070 PHI = CNV * FNASIN(RE * COS(E.MIN / CNV) / (RE + HEIGHT.F2)): TH = 180 - PHI - 90 - E.MIN: GR.MAX = 2 * TH * RE / CNV
  499. 39080 GOSUB 40000: REM   TO MAIN CALCULATION LOOP
  500. 39090 EXIT SUB
  501. 40000 REM   MINIMUF 4.1 CALCULATION LOOP
  502. 40010 COS.GRNG = SIN(T.LAT) * SIN(R.LAT) + COS(T.LAT) * COS(R.LAT) * COS(R.LON - T.LON)
  503. 40020 GRNG = FNACOS(COS.GRNG): IF LPATH% THEN GRNG = 2 * PI - GRNG
  504. 40030 MIN.NHOPS = 1 + FIX(RE * GRNG / GR.MAX)'NUMBER OF 3500 KM HOPS
  505. 40035 NHOPS = MIN.NHOPS + EXTRA.HOPS%
  506. 40040 HOP.INV = 1! / NHOPS
  507. 40050 F.MUF = 100: E.CUTOFF = 0: F.LUF = 0
  508. 40060 ANG = .5 * GRNG / CSNG(NHOPS): R.SLANT = SQR(RE ^ 2 + (RE + HEIGHT.F2) ^ 2 - 2 * RE * (RE + HEIGHT.F2) * COS(ANG))
  509. 40070 ELEV = CNV * FNACOS((RE + HEIGHT.F2) * SIN(ANG) / R.SLANT)
  510. 40080 PHID = CNV * FNASIN(RE * COS(ELEV / CNV) / (RE + HEIGHT.D))' INCIDENCE ANGLE ON D LAYER AT 90 KM
  511. 40090 PATH.LOSS = 2 * FNDB(4 * PI * R.SLANT * 2 * NHOPS * 1000)
  512. 40100 ANG = GRNG / (1 + NHOPS): EL.MAX = ATN(1 / TAN(ANG) - (RE / (RE + HEIGHT.F2)) / SIN(ANG)): IF EL.MAX < 18 / CNV THEN EL.MAX = 18 / CNV
  513. 40110 SEC.EINC = 1 / SQR(1 - ((RE / (RE + HEIGHT.E)) * COS(EL.MAX)) ^ 2)
  514. 40120 FOR I = 1 TO NFREQ
  515. 40130 CALL MULTIPATH(ELEV, WAVE.LEN(I), H.TXANT(I), XMULTV, XMULTH): IF TX.POL%(I) THEN TX.LOSS(I) = XMULTV ELSE TX.LOSS(I) = XMULTH
  516. 40140 CALL MULTIPATH(ELEV, WAVE.LEN(I), H.RXANT(I), XMULTV, XMULTH): IF RX.POL%(I) THEN RX.LOSS(I) = XMULTV ELSE RX.LOSS(I) = XMULTH
  517. 40150 REF.LOSS(I) = 0: ABSORB.LOSS(I) = 0: NEXT I
  518. 40160 FOR KHOP = 1 TO NHOPS: PATH.FRAC = (KHOP - .5) / NHOPS:
  519. 40170 REFL.PATH.FRAC = CSNG(KHOP - 1!) / NHOPS
  520. 40180 SIN.RLAT = SIN(R.LAT)
  521. 40190 COS.RLAT = COS(R.LAT)
  522. 40200 COS.RAZIM = (SIN(T.LAT) - SIN.RLAT * COS(GRNG)) / (COS.RLAT * SIN(GRNG))
  523. 40210 CTRL.RNG = GRNG * PATH.FRAC: REFL.RNG = GRNG * REFL.PATH.FRAC
  524. 40220 SIN.CLAT = SIN.RLAT * COS(CTRL.RNG) + COS.RLAT * SIN(CTRL.RNG) * COS.RAZIM
  525. 40230 SIN.RFLAT = SIN.RLAT * COS(REFL.RNG) + COS.RLAT * SIN(REFL.RNG) * COS.RAZIM
  526. 40240 COS.CLON = (COS(CTRL.RNG) - SIN.CLAT * SIN.RLAT) / (COS.RLAT * SQR(1 - SIN.CLAT ^ 2))
  527. 40250 COS.RFLON = (COS(REFL.RNG) - SIN.RFLAT * SIN.RLAT) / (COS.RLAT * SQR(1 - SIN.RFLAT ^ 2))
  528. 40260 CLON = FNACOS(COS.CLON): RFLON = FNACOS(COS.RFLON)
  529. 40270 C.LON = R.LON + SGN(SIN(T.LON - R.LON)) * CLON
  530. 40280 IF C.LON < 0 THEN C.LON = C.LON + PI2
  531. 40290 IF C.LON >= PI2 THEN C.LON = C.LON - PI2
  532. 40300 C.LAT = PI.D2 - FNACOS(SIN.CLAT)
  533. 40310 RF.LON = R.LON + SGN(SIN(T.LON - R.LON)) * RFLON
  534. 40320 IF RF.LON < 0 THEN RF.LON = RF.LON + PI2
  535. 40330 IF RF.LON >= PI2 THEN RF.LON = RF.LON - PI2
  536. 40340 RF.LAT = (PI.D2 - FNACOS(SIN.RFLAT)) * CNV: RFL = CNV * RF.LON: RF.LON = FNXFORM(-CNV * RF.LON): IF REFL.PATH.FRAC = 0 THEN 40380
  537. 40350 IF POINT(RF.LON, RF.LAT) = 1 THEN SEA% = -1 ELSE SEA% = 0
  538. 40360 FOR I = 1 TO NFREQ: CALL REFLECT(ELEV, WAVE.LEN(I), SEA%, RMV, VP, RMH, HP, REFLECT.LOSS)
  539. 40370 REF.LOSS(I) = REF.LOSS(I) + REFLECT.LOSS: NEXT I
  540. 40380 YR.ANGLE = .0172 * (10 + (MONTH - 1) * 30.4 + DAY)
  541. 40390 TILT.ANGLE = .409 * COS(YR.ANGLE): COSX1 = -1: COSX2 = -1: COSX3 = -1
  542. 40400 T.NOON = 3.82 * C.LON + 12 + .13 * (SIN(YR.ANGLE) + 1.2 * SIN(2 * YR.ANGLE))
  543. 40410 T.NOON = FNT.MOD(T.NOON, 24)
  544. 40420 IF COS(C.LAT + TILT.ANGLE) > -.26 THEN GOTO SUN.LIGHT
  545. 40430 T.SUN = 0
  546. 40440 COSX = 0
  547. 40450 M.FACT! = 2.5 * GRNG * HOP.INV
  548. 40460 IF M.FACT! > PI.D2 THEN M.FACT! = PI.D2
  549. 40470 M.FACT! = SIN(M.FACT!)
  550. 40480 M.FACT! = 1 + 2.5 * M.FACT! * SQR(M.FACT!)
  551. 40490 GOTO MUF.CALC
  552. 40500 SUN.LIGHT:
  553. 40510 T.SUN = (-.26 + SIN(TILT.ANGLE) * SIN(C.LAT)) / (COS(TILT.ANGLE) * COS(C.LAT) + 9.999999E-04)
  554. 40520 T.SUN = 12 - ATN(T.SUN / SQR(ABS(1 - T.SUN * T.SUN))) * 7.639437
  555. 40530 T.RISE = T.NOON - T.SUN / 2 + 12 * (1 - SGN(T.NOON - T.SUN / 2)) * SGN(ABS(T.NOON - T.SUN / 2))
  556. 40540 T.SET = T.NOON + T.SUN / 2 - 12 * (1 + SGN(T.NOON + T.SUN / 2 - 24)) * SGN(ABS(T.NOON + T.SUN / 2 - 24))
  557. 40550 COS.ZEN = ABS(COS(C.LAT + TILT.ANGLE))
  558. 40560 T.RELAX = 9.7 * COS.ZEN ^ 9.600001
  559. 40570 IF T.RELAX < .1 THEN T.RELAX = .1
  560. 40580 M.FACT! = 2.5 * GRNG * HOP.INV
  561. 40590 IF M.FACT! > PI.D2 THEN M.FACT! = PI.D2
  562. 40600 M.FACT! = SIN(M.FACT!)
  563. 40610 M.FACT! = 1 + 2.5 * M.FACT! * SQR(M.FACT!)
  564. 40620 IF T.SET < T.RISE THEN GOTO CHECK.TIME
  565. 40630 IF (GMT - T.RISE) * (T.SET - GMT) > 0 THEN GOTO DAY.TIME
  566. 40800 NITE.TIME:
  567. 40810 GMT0 = GMT + 12 * (1 + SGN(T.SET - GMT)) * SGN(ABS(T.SET - GMT))
  568. 40820 U0 = PI * T.RELAX / T.SUN
  569. 40830 U = (T.SET - GMT0) / 2
  570. 40840 U1 = -T.SUN / T.RELAX
  571. 40850 FRAC.SUN = PI * (GMT0 - T.SET) / (24 - T.SUN)
  572. 40860 COSX = COS.ZEN * (U0 * (EXP(U1) + 1)) * EXP(U) / (1 + U0 * U0): COSX1 = COSX
  573. 40870 FRAC.SUN = 0
  574. 40880 GOTO MUF.CALC
  575. 40900 CHECK.TIME:
  576. 40910 IF (GMT - T.SET) * (T.RISE - GMT) > 0 THEN GOTO NITE.TIME
  577. 41000 DAY.TIME:
  578. 41010 GMT0 = GMT + 12 * (1 + SGN(T.RISE - GMT)) * SGN(ABS(T.RISE - GMT))
  579. 41020 TAU0 = PI * (GMT0 - T.RISE) / T.SUN
  580. 41030 U0 = PI * T.RELAX / T.SUN
  581. 41040 U = (T.RISE - GMT0) / T.RELAX
  582. 41050 FRAC.SUN = PI * (GMT0 - T.RISE) / T.SUN
  583. 41060 COSX = COS.ZEN * (SIN(TAU0) + U0 * (EXP(U) - COS(TAU0))) / (1 + U0 * U0): COSX2 = COSX
  584. 41070 ALT.COSX = COS.ZEN * (U0 * (EXP(-T.SUN / T.RELAX) + 1)) * EXP((T.SUN - 24) / 2) / (1 + U0 * U0): COSX3 = ALT.COSX
  585. 41080 IF COSX >= ALT.COSX THEN GOTO MUF.CALC
  586. 41090 COSX = ALT.COSX
  587. 42000 MUF.CALC:
  588. 42010 MUF! = (1 + SSN / 250) * SQR(6 + 58 * SQR(COSX))
  589. 42020 FVERT = MUF!
  590. 42030 MUF! = MUF! * (1 - .1 * EXP((T.SUN - 24) / 3))
  591. 42040 MUF! = MUF! * (1 + (1 - SGN(T.LAT) * SGN(R.LAT)) * .1)
  592. 42050 MUF! = MUF! * (1 - .1 * (1 + SGN(ABS(SIN(C.LAT)) - COS(C.LAT))))
  593. 42060 FVERT1 = MUF!: MUF! = M.FACT! * MUF!:
  594. 43000 IF MUF! < F.MUF THEN F.MUF = MUF!
  595. 43010 GOSUB ECUTOFF: GOSUB D.LOSS: GOSUB SIGNAL.STRENGTH:
  596. 43020 'GOSUB PRINT.STUFF
  597. 43030 NEXT KHOP
  598. 43040 RETURN
  599. 45000 ECUTOFF: 'CALCULATE E LAYER CUTOFF FREQ
  600. 45010 E.FACT = .2: IF T.SUN = 0 THEN GOTO ESCREEN
  601. 45020 IF T.SUN * FRAC.SUN = 0 THEN GOTO ESCREEN
  602. 45030 E.COSX = COS.ZEN * SIN(PI * (GMT0 - T.RISE) / T.SUN)
  603. 45040 IF E.COSX > .174 THEN E.FACT = E.COSX ^ .3 ELSE E.FACT = (FNACOS(E.COSX) * CNV - 76) ^ -.4
  604. 45050 ESCREEN:
  605. 45060 E.SCREEN = (3.4 + .00544 * SSN) * E.FACT * SEC.EINC
  606. 45070 IF E.SCREEN > 7 THEN E.LUF = (1.33 * E.SCREEN - 3.31) ^ 2 / 7 ELSE E.LUF = .91 * E.SCREEN - .37
  607. 45080 IF F.LUF < E.LUF THEN F.LUF = E.LUF
  608. 45090 IF E.CUTOFF < E.SCREEN THEN E.CUTOFF = E.SCREEN
  609. 45100 RETURN
  610. 46000 D.LOSS: ' CALCULATE D REGION ABSORPTION
  611. 46002 MAG.LAT! = FNASIN(COS(POL.LAT) * COS(C.LAT) * COS(POL.LON - C.LON) + SIN(POL.LAT) * SIN(C.LAT))
  612. 46004 F.GYRO = .8 * SQR(1 + 3 * SIN(MAG.LAT!) ^ 2)
  613. 46010 CHI = CNV * FNACOS(COS.ZEN * SIN(PI * (GMT0 - T.RISE) / T.SUN))
  614. 46020 IF CHI < 102 THEN XLOSS = 1.5 * 430 * (1 + .0035 * SSN) * COS(.881 * CHI / CNV) ^ .75 / (COS(PHID / CNV)) ELSE XLOSS = 0
  615. 46025 IF CHI < 102 THEN XINDEX = (1 + .0037 * SSN) * COS(.881 * CHI / CNV) ^ 1.3 ELSE XINDEX = 0
  616. 46026 IF XINDEX < .1 THEN XINDEX = .1
  617. 46027 XLOSS = 677.2 * XINDEX / (COS(PHID / CNV))
  618. 46030 FOR I = 1 TO NFREQ: ABSORB.LOSS(I) = ABSORB.LOSS(I) + XLOSS / ((FREQ(I) + F.GYRO) ^ 2 + 10.2): NEXT I
  619. 46040 RETURN
  620. 46500 SIGNAL.STRENGTH: 'CALCULATE SIGNAL STRENGTH
  621. 46510 FOR I = 1 TO NFREQ
  622. 46520 PR(I) = FNDB(PT) + GT(I) + TX.LOSS(I) + GR(I) + RX.LOSS(I) + REF.LOSS(I) - ABSORB.LOSS(I) + 2 * FNDB(WAVE.LEN(I)) - PATH.LOSS
  623. 46530 PR(I) = PR(I) - FNDB(.0000005 ^ 2 / 50)
  624. 46540 NEXT I: RETURN
  625. 47000 PRINT.STUFF:
  626. 47010 LPRINT USING "KHOP = ### GMT= ###  Fv=#####.# Fv1=#####.# Mf= ##.### MUF= #####.# "; KHOP; GMT; FVERT; FVERT1; M.FACT!; MUF!
  627. 47020 LPRINT USING "           E.SCREEN=#####.# E.LUF=#####.# E.CUTOFF=#####.# F.LUF= #####.# "; E.SCREEN; E.LUF; E.CUTOFF; F.LUF
  628. 47030 LPRINT USING "     C.LAT=####.#  C.LON=####.# YR.ANGLE=####.# TILT.ANGLE=####.# COS.ZEN=##.###"; C.LAT * CNV; C.LON * CNV; YR.ANGLE * CNV; TILT.ANGLE * CNV; COS.ZEN
  629. 47040 LPRINT USING "     R.LAT=####.#  R.LON=####.# ELEV=####.# PHID=####.# R.SLANT=##### PATH.LOSS=####.#"; RF.LAT; RFL; ELEV; PHID; R.SLANT; PATH.LOSS
  630. 47050 FOR I = 1 TO NFREQ
  631. 47060 LPRINT USING "     F= ###.# TX.LOSS=###.# RX.LOSS=###.# REF.LOSS=###.# ABSORB=###.# PR= ###.#  ###"; FREQ(I); TX.LOSS(I); RX.LOSS(I); REF.LOSS(I); ABSORB.LOSS(I); PR(I); SEA%
  632. 47070 NEXT I
  633. 47080 LPRINT "": RETURN
  634. 47090 LPRINT USING "     T.NOON=###.# T.SUN=###.# T.RISE=###.# T.SET=###.# T.RELAX=###.# "; T.NOON; T.SUN; T.RISE; T.SET; T.RELAX
  635. 47100 LPRINT USING "     COSX=###.##     COSX1=###.## COSX2=###.## COSX3=###.##"; COSX; COSX1; COSX2; COSX3
  636. 47110 LPRINT USING "     TLAT=###.# TLON=###.# RLAT=###.# RLON=###.# GRNG=##### SSN=#### "; TLAT; TLON; RLAT; RLON; RE * GRNG; SSN
  637. 47120 LPRINT "": RETURN
  638. 48000 REM   CALCULATION OF SUNSPOT NUMBER FROM SOLAR FLUX
  639. 48010 SSN = -103.7767 + 1.797429 * SF - (3.384356E-03) * SF ^ 2 + (4.525515E-06) * SF ^ 3
  640. 48020 SSN = INT(100 * SSN + .5) / 100
  641. 48030 RETURN
  642. 50000 END SUB
  643. 51000 '    VIDEO GRAPHICS FOR QUICK BASIC
  644. 51010 '    EMULATION OF CALCOMP ROUTINES
  645. 51020 '
  646. 52000 SUB SCALE (XBEGIN, XEND, YBEGIN, YEND, XDAT(1), YDAT(1)) STATIC
  647. 52010 '    SCALING ROUTINE TO SCALE PLOTS TO THE UNITS OF
  648. 52020 '    THE DATA TO BE PLOTTED
  649. 52030      WINDOW (XBEGIN, YBEGIN)-(XEND, YEND)
  650. 52040      XDAT(1) = XEND - XBEGIN: YDAT(1) = YEND - YBEGIN
  651. 52050      XDAT(2) = XBEGIN: YDAT(2) = YBEGIN
  652. 52060      XDAT(3) = XEND: YDAT(3) = YEND
  653. 52070 END SUB
  654. 52080 '
  655. 53000 SUB AXES (NCOLOR, NX.BEGIN, NX.END, NY.BEGIN, NY.END, XDAT(1), YDAT(1), XTIC, YTIC) STATIC
  656. 53010 '    DRAW BOX WITH AXES AND TIC MARKS
  657. 53020 '    NX..,NY.. ARE DOT VALUES WHICH DEFINE THE BEGINNING & END
  658. 53030 '    OF EACH AXIS IN VIDEO DOT UNITS 0<=DX<=639, 0<=DY<=MAX.VERT
  659. 53040 '    Y VALUES ARE DEFINED WITH 0 AT BOTTOM OF SCREEN.
  660. 53050 '    XTIC,YTIC ARE THE TIC SPACINGS IN UNITS OF THE DATA TO BE
  661. 53060 '    PLOTTED VIA SCALE AND MYLINE. XDAT AND YDAT ARE SCALING DATA IN
  662. 53070 '    SAME UNITS FROM SCALE ROUTINE.
  663. 53080 '    NCOLOR IS THE FOREGROUND COLOR
  664.  
  665. 53090      DEFINT I-N: CALL MY.COLOR( NCOLOR,0)
  666. 53100      IF NX.BEGIN < 0 THEN NX.BEGIN = 0
  667. 53110      IF NX.END < 0 THEN NX.END = 0
  668. 53120      IF NY.BEGIN < 0 THEN NY.BEGIN = 0 ELSE IF NY.BEGIN > MAX.VERT THEN NY.BEGIN = MAX.VERT
  669. 53130      IF NY.END < 0 THEN NY.END = 0 ELSE IF NY.END > MAX.VERT THEN NY.END = MAX.VERT
  670. 53140      VIEW (NX.BEGIN, MAX.VERT - NY.BEGIN)-(NX.END, MAX.VERT - NY.END), , NCOLOR
  671. 53150      DY.TIC = .01 * ABS(XDAT(1)): DX.TIC = .01 * ABS(YDAT(1))
  672. 53160      FOR X = XDAT(2) TO XDAT(3) STEP XTIC
  673. 53170           LINE (X, YDAT(2))-STEP(0, DX.TIC)
  674. 53180           LINE (X, YDAT(3))-STEP(0, -DX.TIC)
  675. 53190      NEXT X
  676. 53200      FOR Y = YDAT(2) TO YDAT(3) STEP YTIC
  677. 53210           LINE (XDAT(2), Y)-STEP(DY.TIC, 0)
  678. 53220           LINE (XDAT(3), Y)-STEP(-DY.TIC, 0)
  679. 53230      NEXT Y
  680. 53240 END SUB
  681. 53250 '
  682. 54000 SUB MYLINE (NCOLOR, X(1), Y(1), NPTS, XDAT(1), YDAT(1)) STATIC
  683.  
  684. 54010      DEFINT I-N
  685. 54015      IF SCR.MODE% =2 OR SCR.MODE%=3 OR SCR.MODE%=10 THEN
  686. 54016         IF NCOLOR= 2 THEN NCOLOR=0
  687. 54017      END IF
  688. 54020      FOR I = 2 TO NPTS
  689. 54030           IF ABS(X(I) - X(I - 1)) > .3 * XDAT(1) OR ABS(Y(I) - Y(I - 1)) > .3 * YDAT(1) THEN 54050
  690. 54040           LINE (X(I - 1), Y(I - 1))-(X(I), Y(I)), NCOLOR
  691. 54050      NEXT I
  692. 54060 END SUB
  693. 55000 SUB UPPER.CASE (A$) STATIC
  694. 55010      L = LEN(A$): IF L = 0 THEN EXIT SUB
  695. 55020      FOR I = 1 TO L
  696. 55030          K = ASC(MID$(A$, I, 1))
  697. 55040          IF K >= 97 AND K <= 122 THEN MID$(A$, I, 1) = CHR$(K - 32)
  698. 55050      NEXT I
  699. 55060 END SUB
  700. 56000 SUB MY.COLOR(N,M) STATIC
  701. 56010     IF SCR.MODE%>=12  THEN
  702. 56020        COLOR N
  703. 56030     ELSEIF SCR.MODE%> 7 AND SCR.MODE% <10 THEN
  704. 56040        COLOR N,M
  705. 56050     ELSEIF SCR.MODE%=0 THEN
  706. 56060        COLOR N,M
  707. 56070     END IF
  708. 56080 END SUB
  709.