home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / misc / hammap / mapper.bas < prev    next >
Encoding:
BASIC Source File  |  1987-10-07  |  23.7 KB  |  507 lines
  1. 100 DEFINT I-N:COLOR 2,0
  2. 110 DIM MENU$(20),MONTH$(12),XDAT(5),YDAT(5),X(1000),Y(1000),XS(400),YS(400),XI(3),XT(3),XU(3),PREFIX$(20),COUNTRY$(20),XLAT(20),XLONG(20)
  3. 120 DATA Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec
  4. 130 FOR I=0 TO 11:READ MONTH$(I):NEXT
  5. 140 DATA "    Menu Options     ","                     ","1*-Select DX Prefix  ","2- Specify Country Name","3- Specify Lat/Lon   ","4- Change Sunspot #  "
  6. 150 DATA "5- Select Date/Time  ","6- Use Real Time     ","7- Select Short Path ","8- Select Long  Path ","9- Quit              "
  7. 160 DATA "                     ","   Choose One "
  8. 170 N.MENU=13:FOR I=1 TO N.MENU:READ MENU$(I):NEXT I
  9. 180 '$DYNAMIC
  10. 190 DIM NSTORE(32500),ZPREFIX$(500),ZCOUNTRY$(500),ZLAT(500),ZLONG(500)
  11. 200 '$STATIC
  12. 300 DEF FNASIN(X)
  13. 310    IF ABS(X)>=.999999 THEN FNASIN=SGN(X)*2*ATN(1):EXIT DEF
  14. 320    FNASIN=ATN(X/SQR(1-X*X))
  15. 330 END DEF
  16. 340 DEF FNACOS(X)
  17. 350    FNACOS=2*ATN(1)-FNASIN(X)
  18. 360 END DEF
  19. 370 DEF FNATN2(X,Y)
  20. 380    IF ABS(X)<.00001 THEN FNATN2=SGN(Y)*2*ATN(1):EXIT DEF
  21. 390    IF ABS(Y)<.00001 THEN FNATN2=2*ATN(1)*(1-SGN(X)):EXIT DEF
  22. 400    IF Y>=0 AND X>0 THEN FNATN2=ATN(Y/X):EXIT DEF
  23. 410    IF Y>=0 AND X<0 THEN FNATN2=2*ATN(1)-ATN(X/Y):EXIT DEF
  24. 420    IF X>0 THEN FNATN2=ATN(Y/X):EXIT DEF
  25. 430    FNATN2=-2*ATN(1)-ATN(X/Y)
  26. 440 END DEF
  27. 450  DEF FNT.MOD(T,T0)= T-.5*T0*(1+SGN(T-T0))*SGN(ABS(T-T0))
  28. 460  DEF FNXFORM(X)
  29. 470      XFORM=X-HOME.LON:IF XFORM>180 THEN XFORM=XFORM-360
  30. 480      IF XFORM<-180 THEN XFORM=360+XFORM
  31. 490      FNXFORM=XFORM
  32. 500 END DEF
  33. 510 DEF FNDIG$(X)
  34. 520 KX=X:AA$=MID$(STR$(KX),2):FNDIG$=AA$:IF LEN(AA$)=1 THEN FNDIG$="0"+AA$
  35. 530 END DEF
  36. 800 PI=4*ATN(1):CNV=180/PI:RE=6364
  37. 810 HOME.LAT=34:HOME.LON=-120  :T.DRAW=20
  38. 1000 PRINT:PRINT
  39. 1010 PRINT "               DX Mapping and HF Propagation Prediction  Program        "
  40. 1020 PRINT "                         Adapted from MINIMUF 3.5 "
  41. 1030 PRINT "                            by Dennis Murray        "
  42. 1040 PRINT :PRINT
  43. 1050 PRINT "          This program is in the Public Domain for non-commercial   "
  44. 1060 PRINT "          use only by anyone who wants to use it or adapt it to
  45. 1070 PRINT "          suit their needs. The author takes no responsibility for "
  46. 1080 PRINT "          guaranteeing that it will work on your machine, nor for "
  47. 1090 PRINT "          supporting this software. It works on AT-compatible machines"
  48. 1100 PRINT "          and requires an EGA Graphics Adapter with color display "
  49. 1110 PRINT "          capable of using BASIC screen mode 9 (640x350 16 color )."
  50. 1120 PRINT "          Modification of the source code will be necessary to make it"
  51. 1130 PRINT "          run in other graphics modes. It is designed to be compiled"
  52. 1140 PRINT "          using Microsoft Quick Basic v2.0 or later, but it can be "
  53. 1150 PRINT "          compiled using Borland Turbo Basic also. "
  54. 1160 PRINT :PRINT
  55. 1170 PRINT "          You are on your own if it doesn't work on your machine!"
  56. 1180 PRINT "                  ( What do you want for free? )"
  57. 1190 PRINT:PRINT "                     Hit any key to proceed";:A$=INPUT$(1):CLS
  58. 1500 OPEN "I",2,"MAPPER.DEF" :INPUT #2,HOME.LAT,HOME.LON,SSN,TDRAW:CLOSE 2
  59. 1510 PRINT :LOCATE 13,16,0:COLOR 20,14,0:PRINT " Fetching DX Atlas  .. Wait a While ";
  60. 1520 OPEN "I",2,"MAPPER.ATL" :K=0
  61. 1530 IF EOF(2 ) THEN N.ATL=K:CLOSE 2:GOTO 2000
  62. 1540 K=K+1:INPUT #2,ZPREFIX$(K),ZLAT(K),ZLONG(K),ZCOUNTRY$(K)
  63. 1550 GOTO 1530
  64. 2000 COLOR 2,0:CLS:PRINT:PRINT
  65. 2010 PRINT USING "                ### DX Atlas Entries Loaded";N.ATL:PRINT
  66. 2020 PRINT
  67. 2030 PRINT       "                Default Values Which Will Be Used Unless Changed"
  68. 2040 PRINT:PRINT USING "                    1- Sunspot Number = ###        ";SSN
  69. 2050 PRINT USING "                    2- Home Latitude/Longitude = ###.# N / ####.# W";HOME.LAT,-HOME.LON
  70. 2060 PRINT USING "                    3- Auto Redraw of Solar Terminator Every ### min";T.DRAW
  71. 2070 PRINT
  72. 2080 PRINT       "                Enter (1-3) to change ... Anything else to accept";
  73. 2090 A$=INPUT$(1):N=VAL(A$):PRINT :PRINT
  74. 2100 IF N=1 THEN INPUT "Enter New Sunspot Number ";SSN:CLS:GOTO 2020
  75. 2110 IF N=3 THEN INPUT "Enter Auto Redraw Interval (Minutes)";T.DRAW:CLS:GOTO 2020
  76. 2120 IF N<>2 THEN 3000
  77. 2130 INPUT "Enter Home Lat/Lon (+ For North Lat and West Lon) ";HOME.LAT,HOME.LON:HOME.LON=-HOME.LON
  78. 2140 HOME.LON=HOME.LON MOD 360:IF HOME.LON>180 THEN HOME.LON=HOME.LON-360
  79. 2150 IF HOME.LON<-180 THEN HOME.LON=360+HOME.LON
  80. 2160 CLS :MAP.FLAG%=-1:GOTO 2020
  81. 3000 OPEN "O",2,"MAPPER.DEF":PRINT #2,HOME.LAT,HOME.LON,SSN,T.DRAW
  82. 3010 CLOSE 2
  83. 3020 ON TIMER(60*T.DRAW) GOSUB REDRAW
  84. 3030 IF MAP.FLAG% THEN GOSUB LAT.LON.SCRN:GOSUB FETCH.MAP :GOTO RESTORE.SCREEN
  85. 3200 CALL PTR86(NSEG,NOFF,VARPTR(NSTORE(0)))
  86. 3210 PRINT :LOCATE 13,16,0:COLOR 20,14,0:PRINT " Fetching Screen Data .. Wait a While ";
  87. 3220 DEF SEG=NSEG:BLOAD "MAPPER.SCR",NOFF:DEF SEG
  88. 3500 RESTORE.SCREEN:
  89. 3510 TIMER ON
  90. 3520 GOSUB GET.DATE:GOSUB LAT.LON.SCRN
  91. 3530 CLS:PAINT (0,0),0,7
  92. 3540 GOSUB DRAW.TERMINATOR
  93. 3550 PUT (XBEGIN,YBEGIN),NSTORE,OR
  94. 3560 GOSUB PAINT.OCEANS
  95. 3570 GOSUB DRAW.LAT.LON
  96. 4000 MENU:
  97. 4010 GOSUB CLEAR.TEXT
  98. 4020 FOR I=1 TO N.MENU:LOCATE I+4,1:PRINT MENU$(I);:NEXT I
  99. 4030 A$=INKEY$:IF A$="" THEN 4030
  100. 4040 IF A$=CHR$(13) THEN A$="1"
  101. 4050 OP%=VAL(A$) :IF OP%<1 OR OP%>9 THEN GOTO MENU
  102. 4060 ON OP% GOTO 4100,4200,4300,4400,4500,4600,4700,4800,4900
  103. 4100 'LOCATION BY PREFIX
  104. 4110 GOSUB GET.PREFIX  :IF K>0 THEN GOTO PATH.CALCULATION
  105. 4120 GOSUB DELAY:GOTO MENU
  106. 4200 'LOCATION BY COUNTRY NAME
  107. 4210 GOSUB GET.COUNTRY  :IF K>0 THEN GOTO PATH.CALCULATION
  108. 4220 GOSUB DELAY:GOTO MENU
  109. 4300 'LAT/LON
  110. 4310 GOSUB CLEAR.TEXT:PRINT "Enter DX Lat/Long "
  111. 4320 INPUT XLAT,XLONG:XLONG=-XLONG:K=1:XLAT(1)=XLAT:XLONG(1)=XLONG
  112. 4330 PREFIX$(1)="":COUNTRY$(1)="Lat= "+STR$(XLAT)+" .. Long= "+STR$(-XLONG)
  113. 4340 GOTO 5010
  114. 4400 'NEW SSN
  115. 4410 GOSUB CLEAR.TEXT:INPUT "Enter Sunspot Num ";SSN:GOSUB 9220:GOTO MENU
  116. 4500 'NEW DATE
  117. 4510 TIMER OFF:GOSUB CLEAR.TEXT:GOSUB GET.NEW.DATE:GOTO 3530
  118. 4600 'REAL TIME MODE
  119. 4610 GOTO RESTORE.SCREEN
  120. 4700 'SET SHORT PATH
  121. 4710 PATH%=0:GOTO MENU:
  122. 4800 'SET LONG PATH
  123. 4810 PATH%=-1:GOTO MENU
  124. 4900 END
  125. 5000 PATH.CALCULATION:
  126. 5010 XLAT=XLAT(K):XLONG=XLONG(K):
  127. 5020 LOCATE 1,26:PRINT SPACE$(54);:LOCATE 1,26
  128. 5030 COLOR 14: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$
  129. 5035 PRINT B$;
  130. 5040 CALL MINIMUF(HOME.LAT,HOME.LON,XLAT,XLONG,PATH%,M0+1,D0,T0,SSN,NHOPS,F.MUF,F.LUF,E.CUTOFF)
  131. 5050 LOCATE 2,26:PRINT SPACE$(54):LOCATE 2,26
  132. 5060 PRINT USING "Fmuf=##.# Fluf=##.# F-Ecof=##.# MHz ## Hops";F.MUF,F.LUF,E.CUTOFF,NHOPS
  133. 5070 CALL TRANSFORM(XLAT(K),XLONG(K),X,Y,-1)
  134. 5080 IF PATH% THEN PATH$="Long " ELSE PATH$="Short"
  135. 5090 LOCATE 1,1:PRINT USING "Predicting \   \ Path to";PATH$
  136. 5100 RNG=SQR(X^2+Y^2)*PI*RE:IF PATH% THEN RNG=2*PI*RE-RNG:X=-X:Y=-Y
  137. 5110 AZIM=FNATN2(Y,X)*CNV
  138. 5120 IF AZIM<0 THEN AZIM=360+AZIM
  139. 5130 LOCATE 2,1:PRINT SPACE$(24);:LOCATE 2,1
  140. 5140 PRINT USING"Range=#####km,#####nm";RNG,RNG/1.85;
  141. 5150 LOCATE 3,1:PRINT SPACE$(24);:LOCATE 3,1
  142. 5160 PRINT USING "Azimuth=#### deg";AZIM;:COLOR 2
  143. 5170 CLAT=COS(XLAT/CNV):SLAT=SIN(XLAT/CNV)
  144. 5180 XLONG=FNXFORM(XLONG)
  145. 5190 CLONG=COS(XLONG/CNV):SLONG=SIN(XLONG/CNV)
  146. 5200 XT(1)=CLAT*CLONG:XT(2)=CLAT*SLONG:XT(3)=SLAT
  147. 5210 XI(1)=COS(HOME.LAT/CNV):XI(2)=0:XI(3)=SIN(HOME.LAT/CNV)
  148. 5220 IF ERASE.FLAG% THEN NCOLOR =2:CALL MYLINE(NCOLOR,X(),Y(),IPTS,XDAT(),YDAT())
  149. 5230 IPTS=101:IF PATH% THEN DPATH=-270/(CNV*(IPTS-1)) ELSE DPATH=90/(CNV*(IPTS-1))
  150. 5240 J=0:FOR JJ=1 TO IPTS:RHO=COS((JJ-1)*DPATH):RHO1=SIN((JJ-1)*DPATH)
  151. 5250 SUM=0:FOR K=0 TO 3:XU(K)=XT(K)*RHO1+XI(K)*RHO:SUM=SUM+XU(K)^2:NEXT K
  152. 5260 SUM=SQR(SUM):FOR K=1 TO 3:XU(K)=XU(K)/SUM:NEXT K
  153. 5270 J=J+1:Y(J)=CNV*ATN(XU(3)/SQR(XU(1)^2+XU(2)^2))
  154. 5280 XU(1)=XU(1)/COS(Y(J)/CNV):XU(2)=XU(2)/COS(Y(J)/CNV)
  155. 5290 IF XU(1)<> 0 THEN X(J)=CNV*ATN(XU(2)/XU(1)) ELSE X(J)=90*SGN(XU(2))
  156. 5300 IF XU(1)<0 THEN IF X(J)<0 THEN X(J)=180+X(J) ELSE X(J)=-180+X(J)
  157. 5310 NEXT JJ:ERASE.FLAG%=-1:CALL MYLINE(14,X(),Y(),IPTS,XDAT(),YDAT())
  158. 5320 GOTO MENU
  159. 6000 GET.PREFIX: 'FETCH COUNTRY DATA
  160. 6010 COLOR 2:
  161. 6020 GOSUB CLEAR.TEXT
  162. 6030 INPUT "Enter DX Prefix";PF$ :L2=LEN(PF$):CALL UPPER.CASE(PF$)
  163. 6040 LOCATE 5,1:PRINT SPACE$(24);:LOCATE 5,1:JP=0
  164. 6050 K=1
  165. 6060 IF JP>N.ATL THEN GOTO 6120
  166. 6070 JP=JP+1:PREFIX$(K)=ZPREFIX$(JP):COUNTRY$(K)=ZCOUNTRY$(JP):XLAT(K)=ZLAT(JP):XLONG(K)=ZLONG(JP)
  167. 6080 L1=LEN(PREFIX$(K)):A$=PF$:IF L2>L1 THEN A$=LEFT$(A$,L1)
  168. 6090 IF INSTR(PREFIX$(K),A$)=0 THEN 6060
  169. 6100 PRINT USING "## ";K;:PRINT LEFT$(PREFIX$(K)+"  "+COUNTRY$(K),20):K=K+1
  170. 6110 IF K<18 THEN 6060
  171. 6120 PRINT :IF K=1  THEN PRINT PF$ +" Not Found   ";:K=-1:RETURN
  172. 6130 INPUT "Select one ";K
  173. 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
  174. 6150 GOSUB CLEAR.TEXT
  175. 6160 XLONG(K)=-XLONG(K):RETURN
  176. 7000 GET.COUNTRY: 'FETCH COUNTRY DATA
  177. 7010 COLOR 2:
  178. 7020 GOSUB CLEAR.TEXT
  179. 7030 PRINT "Enter Country Name ":INPUT CTY$ :L2=LEN(CTY$):CALL UPPER.CASE(CTY$)
  180. 7040 LOCATE 5,1:PRINT SPACE$(24);:LOCATE 6,1:PRINT SPACE$(24);:LOCATE 5,1:JP=0
  181. 7050 K=1
  182. 7060 IF JP>N.ATL THEN GOTO 7130
  183. 7070 JP=JP+1:PREFIX$(K)=ZPREFIX$(JP):COUNTRY$(K)=ZCOUNTRY$(JP):XLAT(K)=ZLAT(JP):XLONG(K)=ZLONG(JP)
  184. 7080 L1=LEN(COUNTRY$(K)):A$=CTY$:IF L2>L1 THEN A$=LEFT$(A$,L1)
  185. 7090 COUNTRY$=COUNTRY$(K):CALL UPPER.CASE(COUNTRY$)
  186. 7100 IF INSTR(COUNTRY$,A$)=0 THEN 7060
  187. 7110 PRINT USING "## ";K;:PRINT LEFT$(PREFIX$(K)+"  "+COUNTRY$(K),20):K=K+1
  188. 7120 IF K<18 THEN 7060
  189. 7130 PRINT :IF K=1  THEN PRINT CTY$ +" Not Found   ";:K=-1:RETURN
  190. 7140 INPUT "Select one ";K
  191. 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
  192. 7160 GOSUB CLEAR.TEXT
  193. 7170 XLONG(K)=-XLONG(K):RETURN
  194. 8000 PAINT.OCEANS: 'PAINT OCEANS
  195. 8010 NCOLOR=7
  196. 8020 PAINT (FNXFORM(6),0),     1,7      'PAINT OCEANS BLUE
  197. 8030 PAINT (FNXFORM(45),-5),   1,7      'PAINT OCEANS BLUE
  198. 8040 PAINT (FNXFORM(60),0),    1,7      'PAINT OCEANS BLUE
  199. 8050 PAINT (FNXFORM(75),0),    1,7      'PAINT OCEANS BLUE
  200. 8060 PAINT (FNXFORM(90),0),    1,7      'PAINT OCEANS BLUE
  201. 8070 PAINT (FNXFORM(105),-15), 1,7      'PAINT OCEANS BLUE
  202. 8080 PAINT (FNXFORM(120),-15), 1,7      'PAINT OCEANS BLUE
  203. 8090 PAINT (FNXFORM(135),15),  1,7      'PAINT OCEANS BLUE
  204. 8100 PAINT (FNXFORM(150),0),   1,7      'PAINT OCEANS BLUE
  205. 8102 PAINT (FNXFORM(180),88),  1,7      'PAINT OCEANS BLUE
  206. 8104 PAINT (FNXFORM(90),88),   1,7      'PAINT OCEANS BLUE
  207. 8106 PAINT (FNXFORM(0),88),    1,7      'PAINT OCEANS BLUE
  208. 8108 PAINT (FNXFORM(-90),88),  1,7      'PAINT OCEANS BLUE
  209. 8109 PAINT (FNXFORM(-180),88), 1,7      'PAINT OCEANS BLUE
  210. 8110 PAINT (FNXFORM(165),0),   1,7      'PAINT OCEANS BLUE
  211. 8120 PAINT (FNXFORM(180),0),   1,7      'PAINT OCEANS BLUE
  212. 8130 PAINT (FNXFORM(-165),0),  1,7      'PAINT OCEANS BLUE
  213. 8140 PAINT (FNXFORM(-150),0),  1,7      'PAINT OCEANS BLUE
  214. 8150 PAINT (FNXFORM(-135),0),  1,7      'PAINT OCEANS BLUE
  215. 8160 PAINT (FNXFORM(-120),0),  1,7      'PAINT OCEANS BLUE
  216. 8170 PAINT (FNXFORM(-105),0),  1,7      'PAINT OCEANS BLUE
  217. 8180 PAINT (FNXFORM(-90),0),   1,7      'PAINT OCEANS BLUE
  218. 8190 PAINT (FNXFORM(-45),5),   1,7      'PAINT OCEANS BLUE
  219. 8200 PAINT (FNXFORM(-30),0),   1,7      'PAINT OCEANS BLUE
  220. 8210 PAINT (FNXFORM(-15),0),   1,7      'PAINT OCEANS BLUE
  221. 8220 PAINT (FNXFORM(58),-5),   1,7      'PAINT OCEANS BLUE
  222. 8230 PAINT (FNXFORM(-124),34), 1,7      'PAINT OCEANS BLUE
  223. 8240 PAINT (FNXFORM(-70),32),  1,7      'PAINT OCEANS BLUE
  224. 8250 PAINT (FNXFORM(5),40),    1,7      'PAINT MED SEA BLUE
  225. 8260 PAINT (FNXFORM(-95),45),  2,7      'PAINT USA YELLOW
  226. 8270 PAINT (FNXFORM(-120),42), 2,7      'PAINT USA YELLOW
  227. 8280 PAINT (FNXFORM(-76),42),  2,7      'PAINT USA YELLOW
  228. 8290 PAINT (FNXFORM(-150),65), 2,7      'PAINT ALASKA YELLOW
  229. 8300 PAINT (FNXFORM(51.5),43), 1,7      'CASPIAN SEA
  230. 8310 PAINT (FNXFORM(-90),60),  1,7      'HUDSONS BAY
  231. 8320 PAINT (FNXFORM(-90),23),  1,7      'GULF OF MEXICO
  232. 8330 RETURN
  233. 8500 DRAW.LAT.LON: 'DRAW LAT/LON LINES
  234. 8510 FOR XLAT=-90 TO 90 STEP 30
  235. 8520 LINE (-180,XLAT)-(180,XLAT),6:NEXT
  236. 8530 FOR XLON=-180 TO 180 STEP 60
  237. 8540 LINE (XLON,-90)-(XLON,90),6:NEXT
  238. 8550 RETURN
  239. 9000 DRAW.TERMINATOR: 'CALCULATE TERMINATOR
  240. 9010 M0=VAL(D$)-1:D0=VAL(MID$(D$,4)):T0=VAL(T$)+VAL(MID$(T$,4))/60
  241. 9020 D0$=FNDIG$(D0):H0$=FNDIG$(INT(T0)):M0$=FNDIG$(60*(T0-INT(T0)))
  242. 9030 YR.ANG=.0172*(10+30.4*M0+D0):TILT=-.409*COS(YR.ANG)
  243. 9040 T.NOON=12+.13*SIN(YR.ANG)+.156*SIN(2*YR.ANG)
  244. 9050 IF M0>=4 AND M0<=10 THEN T.NOON=T.NOON+1 'DAYLIGHT SAVINGS TIME
  245. 9060 DT=-2*PI*(T0-T.NOON)/24 +HOME.LON/CNV
  246. 9070 CP=COS(TILT):SP=SIN(TILT):CD=COS(DT):SD=SIN(DT)
  247. 9080 LL=0:FOR L=1 TO 363:XL=L:CL=COS(XL/CNV):SL=SIN(XL/CNV)
  248. 9090 X1=-(SP*CD*CL+SD*SL)
  249. 9100 Y1=-(SP*SD*CL-CD*SL)
  250. 9110 Z1=CP*CL
  251. 9120 LL=LL+1:XS(LL)=CNV*FNASIN(Z1):YS(LL)=CNV*FNATN2(X1,Y1)-HOME.LON
  252. 9130 IF YS(LL)>180 THEN YS(LL)=YS(LL)-360
  253. 9140 IF LL>1 AND ABS(YS(LL)-YS(LL-1))>60 THEN GOSUB 9260
  254. 9150 NEXT L
  255. 9160 CALL MYLINE(7,YS(),XS(),LL,XDAT(),YDAT())
  256. 9170 X1=CP*CD:Y1=CP*SD:Z1=-SP
  257. 9180 X2=CNV*FNASIN(Z1):Y2=CNV*FNATN2(X1,Y1)-HOME.LON
  258. 9190 IF Y2>180 THEN Y2=Y2-360
  259. 9200 IF ABS(Y2)>178 THEN Y2=178*SGN(Y2)
  260. 9210 PAINT (Y2,X2),4,7
  261. 9220 COLOR 14:LOCATE 3,1:PRINT SPACE$(79);:LOCATE 3,26:
  262. 9230 PRINT USING "\\ \  \ \\:\\ Local .. Sunspot Number = ####";D0$,MONTH$(M0),H0$,M0$,SSN;
  263. 9240 COLOR 2
  264. 9250 RETURN
  265. 9260 YS=YS(LL):YS(LL)=180*SGN(YS(LL-1)):CALL MYLINE(7,YS(),XS(),LL,XDAT(),YDAT())
  266. 9270 YS(1)=180*SGN(YS):YS(2)=YS:
  267. 9280 XS(1)=XS(LL):XS(2)=XS(LL):LL=2 :RETURN
  268. 10000 SUB TRANSFORM(X1,Y1,X2,Y2,POLAR%) STATIC
  269. 10010  STATIC CT0,ST0,NFLAG
  270. 10020 SHARED CNV,PI,HOME.LAT,HOME.LON
  271. 10030  IF NOT NFLAG THEN GOTO INITIALIZE
  272. 10040 NORMAL:
  273. 10050  X=X1:Y=Y1
  274. 10060  Y=FNXFORM(Y):IF NOT POLAR% THEN X2=X:Y2=Y:EXIT SUB
  275. 10070  CT=COS(X/CNV):ST=SIN(X/CNV):CP=COS(Y/CNV):SP=SIN(Y/CNV)
  276. 10080  X1=CT0*ST-ST0*CT*CP
  277. 10090  Y1=CT*SP:Z1=ST0*ST+CT0*CT*CP
  278. 10100  LAM!=FNACOS(Z1):PSI=FNATN2(X1,Y1)
  279. 10110  R=LAM!/PI:X2=R*SIN(PSI):Y2=R*COS(PSI)
  280. 10120  EXIT SUB
  281. 10130 INITIALIZE:
  282. 10140  CT0=COS(HOME.LAT/CNV):ST0=SIN(HOME.LAT/CNV)
  283. 10150  NFLAG=-1:GOTO NORMAL
  284. 10160 END SUB
  285. 12000 FETCH.MAP: 'WORLD MAP DATA INPUT
  286. 12010 OPEN "I",1,"WORLDMAP.DAT":
  287. 12020 INPUT #1,X,Y :J=1
  288. 12030 I=0
  289. 12040 INPUT #1,X,Y  :J=J+1 :Y=FNXFORM(Y)
  290. 12050 IF ABS(X)> 900 THEN CLOSE:GOTO 12120
  291. 12060 IF ABS(X)>91 THEN GOSUB DRAW.LINE:GOTO 12030
  292. 12070 IF ABS(X-Y(I)) > 20  THEN GOSUB DRAW.LINE:I=0:GOTO 12100
  293. 12080 IF ABS(Y-X(I))>20 AND ABS(X(I))<170 THEN GOSUB DRAW.LINE:I=0:GOTO 12100
  294. 12090 IF ABS(Y-X(I))>20  THEN I=I+1:X(I)=181*SGN(X(I-1)):Y(I)=X:GOSUB DRAW.LINE:Y(1)=X:X(1)=-181*SGN(X(I-1)):I=1
  295. 12100 I=I+1:Y(I)=X:X(I)=Y
  296. 12110 GOTO 12040
  297. 12120 GET (-180,-90)-(179,89) ,NSTORE
  298. 12130 CALL PTR86(NSEG,NOFF,VARPTR(NSTORE(0)))
  299. 12140 DEF SEG=NSEG:BSAVE "MAPPER.SCR",NOFF,&HFDE8:DEF SEG
  300. 12150 RETURN
  301. 13000 LAT.LON.SCRN:
  302. 13010 SCREEN 9:COLOR 2,0
  303. 13020 XBEGIN=-180:XEND=180:YBEGIN=-90:YEND=90
  304. 13030 CALL SCALE(XBEGIN,XEND,YBEGIN,YEND,XDAT(),YDAT())
  305. 13040 NCOLOR=7:NX.BEGIN=200:NX.END=600:NY.BEGIN=1:NY.END=300:XTIC=30:YTIC=15
  306. 13050 CALL AXES(NCOLOR,NX.BEGIN,NX.END,NY.BEGIN,NY.END,XDAT(),YDAT(),XTIC,YTIC)
  307. 13060 LINE (-179.5,-89.5) -(179.5,89.5),7,B:COLOR 2
  308. 13070 RETURN
  309. 14000 REDRAW:
  310. 14010 GOSUB GET.DATE:GOSUB LAT.LON.SCRN
  311. 14020 CLS:PAINT (0,0),0,7
  312. 14030 GOSUB DRAW.TERMINATOR
  313. 14040 PUT (-180,-90),NSTORE,OR
  314. 14050 GOSUB PAINT.OCEANS
  315. 14060 GOSUB DRAW.LAT.LON
  316. 14070 TIMER ON
  317. 14080 RETURN
  318. 15000 GET.NEW.DATE: 'ENTER NEW DATE AND TIME
  319. 15010 INPUT "Date (MM-DD) ";D$
  320. 15020 INPUT "Time (HH:MM) ";T$
  321. 15030 IF D$="" THEN D$=DATE$
  322. 15040 IF T$="" THEN T$=TIME$
  323. 15050 RETURN
  324. 16000 GET.DATE: D$=DATE$:T$=TIME$
  325. 16010 RETURN
  326. 17000 DRAW.LINE: CALL MYLINE(NCOLOR,X(),Y(),I,XDAT(),YDAT()):COLOR 2:LOCATE 1,1:PRINT "RECORD ";JJ,J;:'A$=INPUT$(1)
  327. 17010 JJ=J:RETURN
  328. 18000 CLEAR.TEXT: FOR J=5 TO 25:LOCATE J,1:PRINT SPACE$(24);:NEXT J:LOCATE 5,1:RETURN
  329. 19000 DELAY:
  330. 19010 FOR KK=1 TO 10000:NEXT KK:RETURN
  331. 39000 SUB MINIMUF(TLAT,TLON,RLAT,RLON,LPATH%,MONTH,DAY,TIME,SSN,NHOPS,F.MUF,F.LUF,E.CUTOFF) STATIC
  332. 39010 WIDTH LPRINT 128
  333. 39020 DIM M$(37),A$(4),M(12)
  334. 39030 RE=6364:PI=3.141593: RPD=PI/180: PI2=2*PI: CNV=180/PI: PI.D2=PI/2: X$=STRING$(79,61)
  335. 39040 GMT=TIME-TLON/15 :GMT=FNT.MOD(GMT,24)
  336. 39050 T.LAT=TLAT*RPD: T.LON=-TLON*RPD: R.LAT=RLAT*RPD: R.LON=-RLON*RPD:
  337. 39060 'FOR GMT=0 TO 23
  338. 39070 GOSUB 40000 :REM   TO MAIN CALCULATION LOOP
  339. 39080 'NEXT GMT
  340. 39090 EXIT SUB
  341. 40000 REM   MINIMUF 4.1 CALCULATION LOOP
  342. 40010 COS.GRNG=SIN(T.LAT)*SIN(R.LAT)+COS(T.LAT)*COS(R.LAT)*COS(R.LON-T.LON)
  343. 40020 GRNG=FNACOS(COS.GRNG) :IF LPATH% THEN GRNG=2*PI-GRNG
  344. 40030 NHOPS=1+FIX(RE*GRNG/3500) 'NUMBER OF 3500 KM HOPS
  345. 40040 HOP.INV=1!/NHOPS
  346. 40050 F.MUF=100:E.CUTOFF=0:F.LUF=0
  347. 40060 ANG=GRNG/(1+NHOPS):EL.MAX=ATN(1/TAN(ANG)-(RE/(RE+300))/SIN(ANG)):IF EL.MAX<18/CNV THEN EL.MAX=18/CNV
  348. 40070 SEC.EINC= 1/SQR(1-( (RE/(RE+110)) *COS(EL.MAX) )^2)
  349. 40080 FOR KHOP=1 TO NHOPS:PATH.FRAC=(KHOP-.5)/NHOPS
  350. 40090 SIN.RLAT=SIN(R.LAT)
  351. 40100 COS.RLAT=COS(R.LAT)
  352. 40110 COS.RAZIM=(SIN(T.LAT)-SIN.RLAT*COS(GRNG))/(COS.RLAT*SIN(GRNG))
  353. 40120 CTRL.RNG=GRNG*PATH.FRAC
  354. 40130 SIN.CLAT=SIN.RLAT*COS(CTRL.RNG)+COS.RLAT*SIN(CTRL.RNG)*COS.RAZIM
  355. 40140 COS.CLON=(COS(CTRL.RNG)-SIN.CLAT*SIN.RLAT)/(COS.RLAT*SQR(1-SIN.CLAT^2))
  356. 40150 CLON=FNACOS(COS.CLON)
  357. 40160 C.LON=R.LON+SGN(SIN(T.LON-R.LON))*CLON
  358. 40170 IF C.LON<0 THEN C.LON=C.LON+PI2
  359. 40180 IF C.LON>=PI2 THEN C.LON=C.LON-PI2
  360. 40190 C.LAT=PI.D2-FNACOS(SIN.CLAT)
  361. 40200 YR.ANGLE=.0172*(10+(MONTH-1)*30.4+DAY)
  362. 40210 TILT.ANGLE=.409*COS(YR.ANGLE) :COSX1=-1:COSX2=-1:COSX3=-1
  363. 40220 T.NOON=3.82*C.LON+12+.13*(SIN(YR.ANGLE)+1.2*SIN(2*YR.ANGLE))
  364. 40230 T.NOON=FNT.MOD(T.NOON,24)
  365. 40240 IF COS(C.LAT+TILT.ANGLE)>-.26 THEN GOTO SUN.LIGHT
  366. 40250 T.SUN=0
  367. 40260 COSX=0
  368. 40270 M.FACT!=2.5*GRNG*HOP.INV
  369. 40280 IF M.FACT!>PI.D2 THEN M.FACT!=PI.D2
  370. 40290 M.FACT!=SIN(M.FACT!)
  371. 40300 M.FACT!=1+2.5*M.FACT!*SQR(M.FACT!)
  372. 40310 GOTO MUF.CALC
  373. 40500 SUN.LIGHT:
  374. 40510 T.SUN=(-.26+SIN(TILT.ANGLE)*SIN(C.LAT))/(COS(TILT.ANGLE)*COS(C.LAT)+9.999999E-04)
  375. 40520 T.SUN=12-ATN(T.SUN/SQR(ABS(1-T.SUN*T.SUN)))*7.639437
  376. 40530 T.RISE=T.NOON-T.SUN/2+12*(1-SGN(T.NOON-T.SUN/2))*SGN(ABS(T.NOON-T.SUN/2))
  377. 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))
  378. 40550 COS.ZEN=ABS(COS(C.LAT+TILT.ANGLE))
  379. 40560 T.RELAX=9.7*COS.ZEN^9.600001
  380. 40570 IF T.RELAX <.1 THEN T.RELAX=.1
  381. 40580 M.FACT!=2.5*GRNG*HOP.INV
  382. 40590 IF M.FACT!>PI.D2 THEN M.FACT!=PI.D2
  383. 40600 M.FACT!=SIN(M.FACT!)
  384. 40610 M.FACT!=1+2.5*M.FACT!*SQR(M.FACT!)
  385. 40620 IF T.SET<T.RISE THEN GOTO CHECK.TIME
  386. 40630 IF (GMT-T.RISE)*(T.SET-GMT)>0 THEN GOTO DAY.TIME
  387. 40800 NITE.TIME:
  388. 40810 GMT0=GMT+12*(1+SGN(T.SET-GMT))*SGN(ABS(T.SET-GMT))
  389. 40820 U0=PI*T.RELAX/T.SUN
  390. 40830 U=(T.SET-GMT0)/2
  391. 40840 U1=-T.SUN/T.RELAX
  392. 40850 FRAC.SUN=PI*(GMT0-T.SET)/(24-T.SUN)
  393. 40860 COSX=COS.ZEN*(U0*(EXP(U1)+1))*EXP(U)/(1+U0*U0):COSX1=COSX
  394. 40870 FRAC.SUN=0
  395. 40880 GOTO MUF.CALC
  396. 40900 CHECK.TIME:
  397. 40910 IF (GMT-T.SET)*(T.RISE-GMT)>0 THEN GOTO NITE.TIME
  398. 41000 DAY.TIME:
  399. 41010 GMT0=GMT+12*(1+SGN(T.RISE-GMT))*SGN(ABS(T.RISE-GMT))
  400. 41020 TAU0=PI*(GMT0-T.RISE)/T.SUN
  401. 41030 U0=PI*T.RELAX/T.SUN
  402. 41040 U=(T.RISE-GMT0)/T.RELAX
  403. 41050 FRAC.SUN=PI*(GMT0-T.RISE)/T.SUN
  404. 41060 COSX=COS.ZEN*(SIN(TAU0)+U0*(EXP(U)-COS(TAU0)))/(1+U0*U0) :COSX2=COSX
  405. 41070 ALT.COSX=COS.ZEN*(U0*(EXP(-T.SUN/T.RELAX)+1))*EXP((T.SUN-24)/2)/(1+U0*U0):COSX3=ALT.COSX
  406. 41080 IF COSX=>ALT.COSX THEN GOTO MUF.CALC
  407. 41090 COSX=ALT.COSX
  408. 42000 MUF.CALC:
  409. 42010 MUF!=(1+SSN/250)*SQR(6+58*SQR(COSX))
  410. 42020 FVERT=MUF!
  411. 42030 MUF!=MUF!*(1-.1*EXP((T.SUN-24)/3))
  412. 42040 MUF!=MUF!*(1+(1-SGN(T.LAT)*SGN(R.LAT))*.1)
  413. 42050 MUF!=MUF!*(1-.1*(1+SGN(ABS(SIN(C.LAT))-COS(C.LAT))))
  414. 42060 FVERT1=MUF!:MUF!=M.FACT!*MUF!:
  415. 43000 IF MUF!<F.MUF THEN F.MUF=MUF!
  416. 43010 GOSUB ECUTOFF:'GOSUB PRINT.STUFF
  417. 43020 NEXT KHOP
  418. 43030 RETURN
  419. 45000 ECUTOFF: 'CALCULATE E LAYER CUTOFF FREQ
  420. 45010 E.FACT=.2:IF T.SUN=0 THEN GOTO ESCREEN
  421. 45020 IF T.SUN*FRAC.SUN=0  THEN GOTO ESCREEN
  422. 45030 E.COSX=COS.ZEN*SIN(PI*(GMT0-T.RISE)/T.SUN)
  423. 45040 IF E.COSX >.174 THEN E.FACT=E.COSX^.3 ELSE E.FACT=(FNACOS(E.COSX)*CNV-76)^-.4
  424. 45050 ESCREEN:
  425. 45060 E.SCREEN=(3.4+.00544*SSN)*E.FACT*SEC.EINC
  426. 45070 IF E.SCREEN>7 THEN E.LUF=(1.33*E.SCREEN-3.31)^2/7 ELSE E.LUF=.91*E.SCREEN -.37
  427. 45080 IF F.LUF<E.LUF THEN F.LUF=E.LUF
  428. 45090 IF E.CUTOFF<E.SCREEN THEN E.CUTOFF=E.SCREEN
  429. 45100 RETURN
  430. 47000 PRINT.STUFF:
  431. 47010 LPRINT USING "KHOP = ### GMT= ###  Fv=#####.# Fv1=#####.# Mf= ##.### MUF= #####.# ";KHOP,GMT,FVERT,FVERT1,M.FACT!,MUF!
  432. 47020 LPRINT USING "           E.SCREEN=#####.# E.LUF=#####.# E.CUTOFF=#####.# F.LUF= #####.# ";E.SCREEN,E.LUF,E.CUTOFF,F.LUF
  433. 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
  434. 47040 LPRINT "":RETURN
  435. 47050 LPRINT USING "     T.NOON=###.# T.SUN=###.# T.RISE=###.# T.SET=###.# T.RELAX=###.# ";T.NOON,T.SUN,T.RISE,T.SET,T.RELAX
  436. 47060 LPRINT USING "     COSX=###.##     COSX1=###.## COSX2=###.## COSX3=###.##";COSX,COSX1,COSX2,COSX3
  437. 47070 LPRINT USING "     TLAT=###.# TLON=###.# RLAT=###.# RLON=###.# GRNG=##### SSN=#### ";TLAT,TLON,RLAT,RLON,RE*GRNG,SSN
  438. 47080 LPRINT "":RETURN
  439. 48000 REM   CALCULATION OF SUNSPOT NUMBER FROM SOLAR FLUX
  440. 48010 SSN=-103.7767+1.797429*SF-(3.384356E-03)*SF^2+(4.525515E-06)*SF^3
  441. 48020 SSN=INT(100*SSN+.5)/100
  442. 48030 RETURN
  443. 49000 REM SUBROUTINE TO CALCULATE RANGE AND BEARING
  444. 49010 Z1=TLAT*RPD:Z2=R.LAT*RPD:Z3=TLON*RPD:Z4=R.LON*RPD
  445. 49020 R7=SIN(Z1)*SIN(Z2)+COS(Z1)*COS(Z2)*COS(Z4-Z3)
  446. 49030 R8=FNACOS(R7):REM R8 IS DISTANCE IN RADIANS
  447. 49040 DX=R8*180/PI*69.041:REM RANGE IN STATUTE MILES
  448. 49050 C1=(SIN(Z2)-SIN(Z1)*R7)/(COS(Z1)*SIN(R8))
  449. 49060 IF C1>=1 THEN B0=0:GOTO 49080 ELSE IF C1<=-1 THEN B0=180/(180/PI):GOTO 49080
  450. 49070 B0=FNACOS(C1)
  451. 49080 B1=B0*180/PI
  452. 49090 IF SIN(Z3-Z4)<0 THEN B1=360-B1
  453. 49100 RETURN
  454. 50000 END SUB
  455. 51000 '    VIDEO GRAPHICS FOR QUICK BASIC
  456. 51010 '    EMULATION OF CALCOMP ROUTINES
  457. 51020 '
  458. 52000 SUB  SCALE(XBEGIN,XEND,YBEGIN,YEND,XDAT(1),YDAT(1)) STATIC
  459. 52010 '    SCALING ROUTINE TO SCALE PLOTS TO THE UNITS OF
  460. 52020 '    THE DATA TO BE PLOTTED
  461. 52030      WINDOW (XBEGIN,YBEGIN)-(XEND,YEND)
  462. 52040      XDAT(1)=XEND-XBEGIN:YDAT(1)=YEND-YBEGIN
  463. 52050      XDAT(2)=XBEGIN:YDAT(2)=YBEGIN
  464. 52060      XDAT(3)=XEND:YDAT(3)=YEND
  465. 52070 END  SUB
  466. 52080 '
  467. 53000 SUB  AXES(NCOLOR,NX.BEGIN,NX.END,NY.BEGIN,NY.END,XDAT(1),YDAT(1),XTIC,YTIC) STATIC
  468. 53010 '    DRAW BOX WITH AXES AND TIC MARKS
  469. 53020 '    NX..,NY.. ARE DOT VALUES WHICH DEFINE THE BEGINNING & END
  470. 53030 '    OF EACH AXIS IN VIDEO DOT UNITS 0<=DX<=639, 0<=DY<=349
  471. 53040 '    Y VALUES ARE DEFINED WITH 0 AT BOTTOM OF SCREEN.
  472. 53050 '    XTIC,YTIC ARE THE TIC SPACINGS IN UNITS OF THE DATA TO BE
  473. 53060 '    PLOTTED VIA SCALE AND MYLINE. XDAT AND YDAT ARE SCALING DATA IN
  474. 53070 '    SAME UNITS FROM SCALE ROUTINE.
  475. 53080 '    NCOLOR IS THE FOREGROUND COLOR
  476. 53090      DEFINT I-N :COLOR NCOLOR
  477. 53100      IF NX.BEGIN <0 THEN NX.BEGIN=0 ELSE IF NX.BEGIN > 639  THEN NX.BEGIN=639
  478. 53110      IF NX.END   <0 THEN NX.END  =0 ELSE IF NX.END   > 639  THEN NX.END  =639
  479. 53120      IF NY.BEGIN <0 THEN NY.BEGIN=0 ELSE IF NY.BEGIN > 349  THEN NY.BEGIN=349
  480. 53130      IF NY.END   <0 THEN NY.END  =0 ELSE IF NY.END   > 349  THEN NY.END  =349
  481. 53140      VIEW (NX.BEGIN,349-NY.BEGIN)-(NX.END,349-NY.END),,NCOLOR
  482. 53150      DY.TIC=.01*ABS(XDAT(1)):DX.TIC=.01*ABS(YDAT(1))
  483. 53160      FOR X=XDAT(2) TO XDAT(3) STEP XTIC
  484. 53170           LINE (X,YDAT(2))- STEP (0, DX.TIC)
  485. 53180           LINE (X,YDAT(3))- STEP (0,-DX.TIC)
  486. 53190      NEXT X
  487. 53200      FOR Y=YDAT(2) TO YDAT(3) STEP YTIC
  488. 53210           LINE (XDAT(2),Y)- STEP ( DY.TIC,0)
  489. 53220           LINE (XDAT(3),Y)- STEP (-DY.TIC,0)
  490. 53230      NEXT Y
  491. 53240 END  SUB
  492. 53250 '
  493. 54000 SUB  MYLINE(NCOLOR,X(1),Y(1),NPTS,XDAT(1),YDAT(1)) STATIC
  494. 54010      DEFINT I-N
  495. 54020      FOR I=2 TO NPTS
  496. 54030           IF ABS( X(I)-X(I-1) ) >.3*XDAT(1) OR ABS( Y(I)-Y(I-1) ) >.3*YDAT(1) THEN 54050
  497. 54040           LINE (X(I-1),Y(I-1))-(X(I),Y(I)),NCOLOR
  498. 54050      NEXT I
  499. 54060 END  SUB
  500. 55000 SUB  UPPER.CASE(A$) STATIC
  501. 55010      L=LEN(A$):IF L=0 THEN EXIT SUB
  502. 55020      FOR I=1 TO L
  503. 55030          K=ASC(MID$(A$,I,1))
  504. 55040          IF K>=97 AND K<=122 THEN MID$(A$,I,1)=CHR$(K-32)
  505. 55050      NEXT I
  506. 55060 END  SUB
  507.