home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1
/
HamRadio.cdr
/
misc
/
hammap
/
mapper.bas
< prev
next >
Wrap
BASIC Source File
|
1987-10-07
|
24KB
|
507 lines
100 DEFINT I-N:COLOR 2,0
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)
120 DATA Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec
130 FOR I=0 TO 11:READ MONTH$(I):NEXT
140 DATA " Menu Options "," ","1*-Select DX Prefix ","2- Specify Country Name","3- Specify Lat/Lon ","4- Change Sunspot # "
150 DATA "5- Select Date/Time ","6- Use Real Time ","7- Select Short Path ","8- Select Long Path ","9- Quit "
160 DATA " "," Choose One "
170 N.MENU=13:FOR I=1 TO N.MENU:READ MENU$(I):NEXT I
180 '$DYNAMIC
190 DIM NSTORE(32500),ZPREFIX$(500),ZCOUNTRY$(500),ZLAT(500),ZLONG(500)
200 '$STATIC
300 DEF FNASIN(X)
310 IF ABS(X)>=.999999 THEN FNASIN=SGN(X)*2*ATN(1):EXIT DEF
320 FNASIN=ATN(X/SQR(1-X*X))
330 END DEF
340 DEF FNACOS(X)
350 FNACOS=2*ATN(1)-FNASIN(X)
360 END DEF
370 DEF FNATN2(X,Y)
380 IF ABS(X)<.00001 THEN FNATN2=SGN(Y)*2*ATN(1):EXIT DEF
390 IF ABS(Y)<.00001 THEN FNATN2=2*ATN(1)*(1-SGN(X)):EXIT DEF
400 IF Y>=0 AND X>0 THEN FNATN2=ATN(Y/X):EXIT DEF
410 IF Y>=0 AND X<0 THEN FNATN2=2*ATN(1)-ATN(X/Y):EXIT DEF
420 IF X>0 THEN FNATN2=ATN(Y/X):EXIT DEF
430 FNATN2=-2*ATN(1)-ATN(X/Y)
440 END DEF
450 DEF FNT.MOD(T,T0)= T-.5*T0*(1+SGN(T-T0))*SGN(ABS(T-T0))
460 DEF FNXFORM(X)
470 XFORM=X-HOME.LON:IF XFORM>180 THEN XFORM=XFORM-360
480 IF XFORM<-180 THEN XFORM=360+XFORM
490 FNXFORM=XFORM
500 END DEF
510 DEF FNDIG$(X)
520 KX=X:AA$=MID$(STR$(KX),2):FNDIG$=AA$:IF LEN(AA$)=1 THEN FNDIG$="0"+AA$
530 END DEF
800 PI=4*ATN(1):CNV=180/PI:RE=6364
810 HOME.LAT=34:HOME.LON=-120 :T.DRAW=20
1000 PRINT:PRINT
1010 PRINT " DX Mapping and HF Propagation Prediction Program "
1020 PRINT " Adapted from MINIMUF 3.5 "
1030 PRINT " by Dennis Murray "
1040 PRINT :PRINT
1050 PRINT " This program is in the Public Domain for non-commercial "
1060 PRINT " use only by anyone who wants to use it or adapt it to
1070 PRINT " suit their needs. The author takes no responsibility for "
1080 PRINT " guaranteeing that it will work on your machine, nor for "
1090 PRINT " supporting this software. It works on AT-compatible machines"
1100 PRINT " and requires an EGA Graphics Adapter with color display "
1110 PRINT " capable of using BASIC screen mode 9 (640x350 16 color )."
1120 PRINT " Modification of the source code will be necessary to make it"
1130 PRINT " run in other graphics modes. It is designed to be compiled"
1140 PRINT " using Microsoft Quick Basic v2.0 or later, but it can be "
1150 PRINT " compiled using Borland Turbo Basic also. "
1160 PRINT :PRINT
1170 PRINT " You are on your own if it doesn't work on your machine!"
1180 PRINT " ( What do you want for free? )"
1190 PRINT:PRINT " Hit any key to proceed";:A$=INPUT$(1):CLS
1500 OPEN "I",2,"MAPPER.DEF" :INPUT #2,HOME.LAT,HOME.LON,SSN,TDRAW:CLOSE 2
1510 PRINT :LOCATE 13,16,0:COLOR 20,14,0:PRINT " Fetching DX Atlas .. Wait a While ";
1520 OPEN "I",2,"MAPPER.ATL" :K=0
1530 IF EOF(2 ) THEN N.ATL=K:CLOSE 2:GOTO 2000
1540 K=K+1:INPUT #2,ZPREFIX$(K),ZLAT(K),ZLONG(K),ZCOUNTRY$(K)
1550 GOTO 1530
2000 COLOR 2,0:CLS:PRINT:PRINT
2010 PRINT USING " ### DX Atlas Entries Loaded";N.ATL:PRINT
2020 PRINT
2030 PRINT " Default Values Which Will Be Used Unless Changed"
2040 PRINT:PRINT USING " 1- Sunspot Number = ### ";SSN
2050 PRINT USING " 2- Home Latitude/Longitude = ###.# N / ####.# W";HOME.LAT,-HOME.LON
2060 PRINT USING " 3- Auto Redraw of Solar Terminator Every ### min";T.DRAW
2070 PRINT
2080 PRINT " Enter (1-3) to change ... Anything else to accept";
2090 A$=INPUT$(1):N=VAL(A$):PRINT :PRINT
2100 IF N=1 THEN INPUT "Enter New Sunspot Number ";SSN:CLS:GOTO 2020
2110 IF N=3 THEN INPUT "Enter Auto Redraw Interval (Minutes)";T.DRAW:CLS:GOTO 2020
2120 IF N<>2 THEN 3000
2130 INPUT "Enter Home Lat/Lon (+ For North Lat and West Lon) ";HOME.LAT,HOME.LON:HOME.LON=-HOME.LON
2140 HOME.LON=HOME.LON MOD 360:IF HOME.LON>180 THEN HOME.LON=HOME.LON-360
2150 IF HOME.LON<-180 THEN HOME.LON=360+HOME.LON
2160 CLS :MAP.FLAG%=-1:GOTO 2020
3000 OPEN "O",2,"MAPPER.DEF":PRINT #2,HOME.LAT,HOME.LON,SSN,T.DRAW
3010 CLOSE 2
3020 ON TIMER(60*T.DRAW) GOSUB REDRAW
3030 IF MAP.FLAG% THEN GOSUB LAT.LON.SCRN:GOSUB FETCH.MAP :GOTO RESTORE.SCREEN
3200 CALL PTR86(NSEG,NOFF,VARPTR(NSTORE(0)))
3210 PRINT :LOCATE 13,16,0:COLOR 20,14,0:PRINT " Fetching Screen Data .. Wait a While ";
3220 DEF SEG=NSEG:BLOAD "MAPPER.SCR",NOFF:DEF SEG
3500 RESTORE.SCREEN:
3510 TIMER ON
3520 GOSUB GET.DATE:GOSUB LAT.LON.SCRN
3530 CLS:PAINT (0,0),0,7
3540 GOSUB DRAW.TERMINATOR
3550 PUT (XBEGIN,YBEGIN),NSTORE,OR
3560 GOSUB PAINT.OCEANS
3570 GOSUB DRAW.LAT.LON
4000 MENU:
4010 GOSUB CLEAR.TEXT
4020 FOR I=1 TO N.MENU:LOCATE I+4,1:PRINT MENU$(I);:NEXT I
4030 A$=INKEY$:IF A$="" THEN 4030
4040 IF A$=CHR$(13) THEN A$="1"
4050 OP%=VAL(A$) :IF OP%<1 OR OP%>9 THEN GOTO MENU
4060 ON OP% GOTO 4100,4200,4300,4400,4500,4600,4700,4800,4900
4100 'LOCATION BY PREFIX
4110 GOSUB GET.PREFIX :IF K>0 THEN GOTO PATH.CALCULATION
4120 GOSUB DELAY:GOTO MENU
4200 'LOCATION BY COUNTRY NAME
4210 GOSUB GET.COUNTRY :IF K>0 THEN GOTO PATH.CALCULATION
4220 GOSUB DELAY:GOTO MENU
4300 'LAT/LON
4310 GOSUB CLEAR.TEXT:PRINT "Enter DX Lat/Long "
4320 INPUT XLAT,XLONG:XLONG=-XLONG:K=1:XLAT(1)=XLAT:XLONG(1)=XLONG
4330 PREFIX$(1)="":COUNTRY$(1)="Lat= "+STR$(XLAT)+" .. Long= "+STR$(-XLONG)
4340 GOTO 5010
4400 'NEW SSN
4410 GOSUB CLEAR.TEXT:INPUT "Enter Sunspot Num ";SSN:GOSUB 9220:GOTO MENU
4500 'NEW DATE
4510 TIMER OFF:GOSUB CLEAR.TEXT:GOSUB GET.NEW.DATE:GOTO 3530
4600 'REAL TIME MODE
4610 GOTO RESTORE.SCREEN
4700 'SET SHORT PATH
4710 PATH%=0:GOTO MENU:
4800 'SET LONG PATH
4810 PATH%=-1:GOTO MENU
4900 END
5000 PATH.CALCULATION:
5010 XLAT=XLAT(K):XLONG=XLONG(K):
5020 LOCATE 1,26:PRINT SPACE$(54);:LOCATE 1,26
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$
5035 PRINT B$;
5040 CALL MINIMUF(HOME.LAT,HOME.LON,XLAT,XLONG,PATH%,M0+1,D0,T0,SSN,NHOPS,F.MUF,F.LUF,E.CUTOFF)
5050 LOCATE 2,26:PRINT SPACE$(54):LOCATE 2,26
5060 PRINT USING "Fmuf=##.# Fluf=##.# F-Ecof=##.# MHz ## Hops";F.MUF,F.LUF,E.CUTOFF,NHOPS
5070 CALL TRANSFORM(XLAT(K),XLONG(K),X,Y,-1)
5080 IF PATH% THEN PATH$="Long " ELSE PATH$="Short"
5090 LOCATE 1,1:PRINT USING "Predicting \ \ Path to";PATH$
5100 RNG=SQR(X^2+Y^2)*PI*RE:IF PATH% THEN RNG=2*PI*RE-RNG:X=-X:Y=-Y
5110 AZIM=FNATN2(Y,X)*CNV
5120 IF AZIM<0 THEN AZIM=360+AZIM
5130 LOCATE 2,1:PRINT SPACE$(24);:LOCATE 2,1
5140 PRINT USING"Range=#####km,#####nm";RNG,RNG/1.85;
5150 LOCATE 3,1:PRINT SPACE$(24);:LOCATE 3,1
5160 PRINT USING "Azimuth=#### deg";AZIM;:COLOR 2
5170 CLAT=COS(XLAT/CNV):SLAT=SIN(XLAT/CNV)
5180 XLONG=FNXFORM(XLONG)
5190 CLONG=COS(XLONG/CNV):SLONG=SIN(XLONG/CNV)
5200 XT(1)=CLAT*CLONG:XT(2)=CLAT*SLONG:XT(3)=SLAT
5210 XI(1)=COS(HOME.LAT/CNV):XI(2)=0:XI(3)=SIN(HOME.LAT/CNV)
5220 IF ERASE.FLAG% THEN NCOLOR =2:CALL MYLINE(NCOLOR,X(),Y(),IPTS,XDAT(),YDAT())
5230 IPTS=101:IF PATH% THEN DPATH=-270/(CNV*(IPTS-1)) ELSE DPATH=90/(CNV*(IPTS-1))
5240 J=0:FOR JJ=1 TO IPTS:RHO=COS((JJ-1)*DPATH):RHO1=SIN((JJ-1)*DPATH)
5250 SUM=0:FOR K=0 TO 3:XU(K)=XT(K)*RHO1+XI(K)*RHO:SUM=SUM+XU(K)^2:NEXT K
5260 SUM=SQR(SUM):FOR K=1 TO 3:XU(K)=XU(K)/SUM:NEXT K
5270 J=J+1:Y(J)=CNV*ATN(XU(3)/SQR(XU(1)^2+XU(2)^2))
5280 XU(1)=XU(1)/COS(Y(J)/CNV):XU(2)=XU(2)/COS(Y(J)/CNV)
5290 IF XU(1)<> 0 THEN X(J)=CNV*ATN(XU(2)/XU(1)) ELSE X(J)=90*SGN(XU(2))
5300 IF XU(1)<0 THEN IF X(J)<0 THEN X(J)=180+X(J) ELSE X(J)=-180+X(J)
5310 NEXT JJ:ERASE.FLAG%=-1:CALL MYLINE(14,X(),Y(),IPTS,XDAT(),YDAT())
5320 GOTO MENU
6000 GET.PREFIX: 'FETCH COUNTRY DATA
6010 COLOR 2:
6020 GOSUB CLEAR.TEXT
6030 INPUT "Enter DX Prefix";PF$ :L2=LEN(PF$):CALL UPPER.CASE(PF$)
6040 LOCATE 5,1:PRINT SPACE$(24);:LOCATE 5,1:JP=0
6050 K=1
6060 IF JP>N.ATL THEN GOTO 6120
6070 JP=JP+1:PREFIX$(K)=ZPREFIX$(JP):COUNTRY$(K)=ZCOUNTRY$(JP):XLAT(K)=ZLAT(JP):XLONG(K)=ZLONG(JP)
6080 L1=LEN(PREFIX$(K)):A$=PF$:IF L2>L1 THEN A$=LEFT$(A$,L1)
6090 IF INSTR(PREFIX$(K),A$)=0 THEN 6060
6100 PRINT USING "## ";K;:PRINT LEFT$(PREFIX$(K)+" "+COUNTRY$(K),20):K=K+1
6110 IF K<18 THEN 6060
6120 PRINT :IF K=1 THEN PRINT PF$ +" Not Found ";:K=-1:RETURN
6130 INPUT "Select one ";K
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
6150 GOSUB CLEAR.TEXT
6160 XLONG(K)=-XLONG(K):RETURN
7000 GET.COUNTRY: 'FETCH COUNTRY DATA
7010 COLOR 2:
7020 GOSUB CLEAR.TEXT
7030 PRINT "Enter Country Name ":INPUT CTY$ :L2=LEN(CTY$):CALL UPPER.CASE(CTY$)
7040 LOCATE 5,1:PRINT SPACE$(24);:LOCATE 6,1:PRINT SPACE$(24);:LOCATE 5,1:JP=0
7050 K=1
7060 IF JP>N.ATL THEN GOTO 7130
7070 JP=JP+1:PREFIX$(K)=ZPREFIX$(JP):COUNTRY$(K)=ZCOUNTRY$(JP):XLAT(K)=ZLAT(JP):XLONG(K)=ZLONG(JP)
7080 L1=LEN(COUNTRY$(K)):A$=CTY$:IF L2>L1 THEN A$=LEFT$(A$,L1)
7090 COUNTRY$=COUNTRY$(K):CALL UPPER.CASE(COUNTRY$)
7100 IF INSTR(COUNTRY$,A$)=0 THEN 7060
7110 PRINT USING "## ";K;:PRINT LEFT$(PREFIX$(K)+" "+COUNTRY$(K),20):K=K+1
7120 IF K<18 THEN 7060
7130 PRINT :IF K=1 THEN PRINT CTY$ +" Not Found ";:K=-1:RETURN
7140 INPUT "Select one ";K
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
7160 GOSUB CLEAR.TEXT
7170 XLONG(K)=-XLONG(K):RETURN
8000 PAINT.OCEANS: 'PAINT OCEANS
8010 NCOLOR=7
8020 PAINT (FNXFORM(6),0), 1,7 'PAINT OCEANS BLUE
8030 PAINT (FNXFORM(45),-5), 1,7 'PAINT OCEANS BLUE
8040 PAINT (FNXFORM(60),0), 1,7 'PAINT OCEANS BLUE
8050 PAINT (FNXFORM(75),0), 1,7 'PAINT OCEANS BLUE
8060 PAINT (FNXFORM(90),0), 1,7 'PAINT OCEANS BLUE
8070 PAINT (FNXFORM(105),-15), 1,7 'PAINT OCEANS BLUE
8080 PAINT (FNXFORM(120),-15), 1,7 'PAINT OCEANS BLUE
8090 PAINT (FNXFORM(135),15), 1,7 'PAINT OCEANS BLUE
8100 PAINT (FNXFORM(150),0), 1,7 'PAINT OCEANS BLUE
8102 PAINT (FNXFORM(180),88), 1,7 'PAINT OCEANS BLUE
8104 PAINT (FNXFORM(90),88), 1,7 'PAINT OCEANS BLUE
8106 PAINT (FNXFORM(0),88), 1,7 'PAINT OCEANS BLUE
8108 PAINT (FNXFORM(-90),88), 1,7 'PAINT OCEANS BLUE
8109 PAINT (FNXFORM(-180),88), 1,7 'PAINT OCEANS BLUE
8110 PAINT (FNXFORM(165),0), 1,7 'PAINT OCEANS BLUE
8120 PAINT (FNXFORM(180),0), 1,7 'PAINT OCEANS BLUE
8130 PAINT (FNXFORM(-165),0), 1,7 'PAINT OCEANS BLUE
8140 PAINT (FNXFORM(-150),0), 1,7 'PAINT OCEANS BLUE
8150 PAINT (FNXFORM(-135),0), 1,7 'PAINT OCEANS BLUE
8160 PAINT (FNXFORM(-120),0), 1,7 'PAINT OCEANS BLUE
8170 PAINT (FNXFORM(-105),0), 1,7 'PAINT OCEANS BLUE
8180 PAINT (FNXFORM(-90),0), 1,7 'PAINT OCEANS BLUE
8190 PAINT (FNXFORM(-45),5), 1,7 'PAINT OCEANS BLUE
8200 PAINT (FNXFORM(-30),0), 1,7 'PAINT OCEANS BLUE
8210 PAINT (FNXFORM(-15),0), 1,7 'PAINT OCEANS BLUE
8220 PAINT (FNXFORM(58),-5), 1,7 'PAINT OCEANS BLUE
8230 PAINT (FNXFORM(-124),34), 1,7 'PAINT OCEANS BLUE
8240 PAINT (FNXFORM(-70),32), 1,7 'PAINT OCEANS BLUE
8250 PAINT (FNXFORM(5),40), 1,7 'PAINT MED SEA BLUE
8260 PAINT (FNXFORM(-95),45), 2,7 'PAINT USA YELLOW
8270 PAINT (FNXFORM(-120),42), 2,7 'PAINT USA YELLOW
8280 PAINT (FNXFORM(-76),42), 2,7 'PAINT USA YELLOW
8290 PAINT (FNXFORM(-150),65), 2,7 'PAINT ALASKA YELLOW
8300 PAINT (FNXFORM(51.5),43), 1,7 'CASPIAN SEA
8310 PAINT (FNXFORM(-90),60), 1,7 'HUDSONS BAY
8320 PAINT (FNXFORM(-90),23), 1,7 'GULF OF MEXICO
8330 RETURN
8500 DRAW.LAT.LON: 'DRAW LAT/LON LINES
8510 FOR XLAT=-90 TO 90 STEP 30
8520 LINE (-180,XLAT)-(180,XLAT),6:NEXT
8530 FOR XLON=-180 TO 180 STEP 60
8540 LINE (XLON,-90)-(XLON,90),6:NEXT
8550 RETURN
9000 DRAW.TERMINATOR: 'CALCULATE TERMINATOR
9010 M0=VAL(D$)-1:D0=VAL(MID$(D$,4)):T0=VAL(T$)+VAL(MID$(T$,4))/60
9020 D0$=FNDIG$(D0):H0$=FNDIG$(INT(T0)):M0$=FNDIG$(60*(T0-INT(T0)))
9030 YR.ANG=.0172*(10+30.4*M0+D0):TILT=-.409*COS(YR.ANG)
9040 T.NOON=12+.13*SIN(YR.ANG)+.156*SIN(2*YR.ANG)
9050 IF M0>=4 AND M0<=10 THEN T.NOON=T.NOON+1 'DAYLIGHT SAVINGS TIME
9060 DT=-2*PI*(T0-T.NOON)/24 +HOME.LON/CNV
9070 CP=COS(TILT):SP=SIN(TILT):CD=COS(DT):SD=SIN(DT)
9080 LL=0:FOR L=1 TO 363:XL=L:CL=COS(XL/CNV):SL=SIN(XL/CNV)
9090 X1=-(SP*CD*CL+SD*SL)
9100 Y1=-(SP*SD*CL-CD*SL)
9110 Z1=CP*CL
9120 LL=LL+1:XS(LL)=CNV*FNASIN(Z1):YS(LL)=CNV*FNATN2(X1,Y1)-HOME.LON
9130 IF YS(LL)>180 THEN YS(LL)=YS(LL)-360
9140 IF LL>1 AND ABS(YS(LL)-YS(LL-1))>60 THEN GOSUB 9260
9150 NEXT L
9160 CALL MYLINE(7,YS(),XS(),LL,XDAT(),YDAT())
9170 X1=CP*CD:Y1=CP*SD:Z1=-SP
9180 X2=CNV*FNASIN(Z1):Y2=CNV*FNATN2(X1,Y1)-HOME.LON
9190 IF Y2>180 THEN Y2=Y2-360
9200 IF ABS(Y2)>178 THEN Y2=178*SGN(Y2)
9210 PAINT (Y2,X2),4,7
9220 COLOR 14:LOCATE 3,1:PRINT SPACE$(79);:LOCATE 3,26:
9230 PRINT USING "\\ \ \ \\:\\ Local .. Sunspot Number = ####";D0$,MONTH$(M0),H0$,M0$,SSN;
9240 COLOR 2
9250 RETURN
9260 YS=YS(LL):YS(LL)=180*SGN(YS(LL-1)):CALL MYLINE(7,YS(),XS(),LL,XDAT(),YDAT())
9270 YS(1)=180*SGN(YS):YS(2)=YS:
9280 XS(1)=XS(LL):XS(2)=XS(LL):LL=2 :RETURN
10000 SUB TRANSFORM(X1,Y1,X2,Y2,POLAR%) STATIC
10010 STATIC CT0,ST0,NFLAG
10020 SHARED CNV,PI,HOME.LAT,HOME.LON
10030 IF NOT NFLAG THEN GOTO INITIALIZE
10040 NORMAL:
10050 X=X1:Y=Y1
10060 Y=FNXFORM(Y):IF NOT POLAR% THEN X2=X:Y2=Y:EXIT SUB
10070 CT=COS(X/CNV):ST=SIN(X/CNV):CP=COS(Y/CNV):SP=SIN(Y/CNV)
10080 X1=CT0*ST-ST0*CT*CP
10090 Y1=CT*SP:Z1=ST0*ST+CT0*CT*CP
10100 LAM!=FNACOS(Z1):PSI=FNATN2(X1,Y1)
10110 R=LAM!/PI:X2=R*SIN(PSI):Y2=R*COS(PSI)
10120 EXIT SUB
10130 INITIALIZE:
10140 CT0=COS(HOME.LAT/CNV):ST0=SIN(HOME.LAT/CNV)
10150 NFLAG=-1:GOTO NORMAL
10160 END SUB
12000 FETCH.MAP: 'WORLD MAP DATA INPUT
12010 OPEN "I",1,"WORLDMAP.DAT":
12020 INPUT #1,X,Y :J=1
12030 I=0
12040 INPUT #1,X,Y :J=J+1 :Y=FNXFORM(Y)
12050 IF ABS(X)> 900 THEN CLOSE:GOTO 12120
12060 IF ABS(X)>91 THEN GOSUB DRAW.LINE:GOTO 12030
12070 IF ABS(X-Y(I)) > 20 THEN GOSUB DRAW.LINE:I=0:GOTO 12100
12080 IF ABS(Y-X(I))>20 AND ABS(X(I))<170 THEN GOSUB DRAW.LINE:I=0:GOTO 12100
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
12100 I=I+1:Y(I)=X:X(I)=Y
12110 GOTO 12040
12120 GET (-180,-90)-(179,89) ,NSTORE
12130 CALL PTR86(NSEG,NOFF,VARPTR(NSTORE(0)))
12140 DEF SEG=NSEG:BSAVE "MAPPER.SCR",NOFF,&HFDE8:DEF SEG
12150 RETURN
13000 LAT.LON.SCRN:
13010 SCREEN 9:COLOR 2,0
13020 XBEGIN=-180:XEND=180:YBEGIN=-90:YEND=90
13030 CALL SCALE(XBEGIN,XEND,YBEGIN,YEND,XDAT(),YDAT())
13040 NCOLOR=7:NX.BEGIN=200:NX.END=600:NY.BEGIN=1:NY.END=300:XTIC=30:YTIC=15
13050 CALL AXES(NCOLOR,NX.BEGIN,NX.END,NY.BEGIN,NY.END,XDAT(),YDAT(),XTIC,YTIC)
13060 LINE (-179.5,-89.5) -(179.5,89.5),7,B:COLOR 2
13070 RETURN
14000 REDRAW:
14010 GOSUB GET.DATE:GOSUB LAT.LON.SCRN
14020 CLS:PAINT (0,0),0,7
14030 GOSUB DRAW.TERMINATOR
14040 PUT (-180,-90),NSTORE,OR
14050 GOSUB PAINT.OCEANS
14060 GOSUB DRAW.LAT.LON
14070 TIMER ON
14080 RETURN
15000 GET.NEW.DATE: 'ENTER NEW DATE AND TIME
15010 INPUT "Date (MM-DD) ";D$
15020 INPUT "Time (HH:MM) ";T$
15030 IF D$="" THEN D$=DATE$
15040 IF T$="" THEN T$=TIME$
15050 RETURN
16000 GET.DATE: D$=DATE$:T$=TIME$
16010 RETURN
17000 DRAW.LINE: CALL MYLINE(NCOLOR,X(),Y(),I,XDAT(),YDAT()):COLOR 2:LOCATE 1,1:PRINT "RECORD ";JJ,J;:'A$=INPUT$(1)
17010 JJ=J:RETURN
18000 CLEAR.TEXT: FOR J=5 TO 25:LOCATE J,1:PRINT SPACE$(24);:NEXT J:LOCATE 5,1:RETURN
19000 DELAY:
19010 FOR KK=1 TO 10000:NEXT KK:RETURN
39000 SUB MINIMUF(TLAT,TLON,RLAT,RLON,LPATH%,MONTH,DAY,TIME,SSN,NHOPS,F.MUF,F.LUF,E.CUTOFF) STATIC
39010 WIDTH LPRINT 128
39020 DIM M$(37),A$(4),M(12)
39030 RE=6364:PI=3.141593: RPD=PI/180: PI2=2*PI: CNV=180/PI: PI.D2=PI/2: X$=STRING$(79,61)
39040 GMT=TIME-TLON/15 :GMT=FNT.MOD(GMT,24)
39050 T.LAT=TLAT*RPD: T.LON=-TLON*RPD: R.LAT=RLAT*RPD: R.LON=-RLON*RPD:
39060 'FOR GMT=0 TO 23
39070 GOSUB 40000 :REM TO MAIN CALCULATION LOOP
39080 'NEXT GMT
39090 EXIT SUB
40000 REM MINIMUF 4.1 CALCULATION LOOP
40010 COS.GRNG=SIN(T.LAT)*SIN(R.LAT)+COS(T.LAT)*COS(R.LAT)*COS(R.LON-T.LON)
40020 GRNG=FNACOS(COS.GRNG) :IF LPATH% THEN GRNG=2*PI-GRNG
40030 NHOPS=1+FIX(RE*GRNG/3500) 'NUMBER OF 3500 KM HOPS
40040 HOP.INV=1!/NHOPS
40050 F.MUF=100:E.CUTOFF=0:F.LUF=0
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
40070 SEC.EINC= 1/SQR(1-( (RE/(RE+110)) *COS(EL.MAX) )^2)
40080 FOR KHOP=1 TO NHOPS:PATH.FRAC=(KHOP-.5)/NHOPS
40090 SIN.RLAT=SIN(R.LAT)
40100 COS.RLAT=COS(R.LAT)
40110 COS.RAZIM=(SIN(T.LAT)-SIN.RLAT*COS(GRNG))/(COS.RLAT*SIN(GRNG))
40120 CTRL.RNG=GRNG*PATH.FRAC
40130 SIN.CLAT=SIN.RLAT*COS(CTRL.RNG)+COS.RLAT*SIN(CTRL.RNG)*COS.RAZIM
40140 COS.CLON=(COS(CTRL.RNG)-SIN.CLAT*SIN.RLAT)/(COS.RLAT*SQR(1-SIN.CLAT^2))
40150 CLON=FNACOS(COS.CLON)
40160 C.LON=R.LON+SGN(SIN(T.LON-R.LON))*CLON
40170 IF C.LON<0 THEN C.LON=C.LON+PI2
40180 IF C.LON>=PI2 THEN C.LON=C.LON-PI2
40190 C.LAT=PI.D2-FNACOS(SIN.CLAT)
40200 YR.ANGLE=.0172*(10+(MONTH-1)*30.4+DAY)
40210 TILT.ANGLE=.409*COS(YR.ANGLE) :COSX1=-1:COSX2=-1:COSX3=-1
40220 T.NOON=3.82*C.LON+12+.13*(SIN(YR.ANGLE)+1.2*SIN(2*YR.ANGLE))
40230 T.NOON=FNT.MOD(T.NOON,24)
40240 IF COS(C.LAT+TILT.ANGLE)>-.26 THEN GOTO SUN.LIGHT
40250 T.SUN=0
40260 COSX=0
40270 M.FACT!=2.5*GRNG*HOP.INV
40280 IF M.FACT!>PI.D2 THEN M.FACT!=PI.D2
40290 M.FACT!=SIN(M.FACT!)
40300 M.FACT!=1+2.5*M.FACT!*SQR(M.FACT!)
40310 GOTO MUF.CALC
40500 SUN.LIGHT:
40510 T.SUN=(-.26+SIN(TILT.ANGLE)*SIN(C.LAT))/(COS(TILT.ANGLE)*COS(C.LAT)+9.999999E-04)
40520 T.SUN=12-ATN(T.SUN/SQR(ABS(1-T.SUN*T.SUN)))*7.639437
40530 T.RISE=T.NOON-T.SUN/2+12*(1-SGN(T.NOON-T.SUN/2))*SGN(ABS(T.NOON-T.SUN/2))
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))
40550 COS.ZEN=ABS(COS(C.LAT+TILT.ANGLE))
40560 T.RELAX=9.7*COS.ZEN^9.600001
40570 IF T.RELAX <.1 THEN T.RELAX=.1
40580 M.FACT!=2.5*GRNG*HOP.INV
40590 IF M.FACT!>PI.D2 THEN M.FACT!=PI.D2
40600 M.FACT!=SIN(M.FACT!)
40610 M.FACT!=1+2.5*M.FACT!*SQR(M.FACT!)
40620 IF T.SET<T.RISE THEN GOTO CHECK.TIME
40630 IF (GMT-T.RISE)*(T.SET-GMT)>0 THEN GOTO DAY.TIME
40800 NITE.TIME:
40810 GMT0=GMT+12*(1+SGN(T.SET-GMT))*SGN(ABS(T.SET-GMT))
40820 U0=PI*T.RELAX/T.SUN
40830 U=(T.SET-GMT0)/2
40840 U1=-T.SUN/T.RELAX
40850 FRAC.SUN=PI*(GMT0-T.SET)/(24-T.SUN)
40860 COSX=COS.ZEN*(U0*(EXP(U1)+1))*EXP(U)/(1+U0*U0):COSX1=COSX
40870 FRAC.SUN=0
40880 GOTO MUF.CALC
40900 CHECK.TIME:
40910 IF (GMT-T.SET)*(T.RISE-GMT)>0 THEN GOTO NITE.TIME
41000 DAY.TIME:
41010 GMT0=GMT+12*(1+SGN(T.RISE-GMT))*SGN(ABS(T.RISE-GMT))
41020 TAU0=PI*(GMT0-T.RISE)/T.SUN
41030 U0=PI*T.RELAX/T.SUN
41040 U=(T.RISE-GMT0)/T.RELAX
41050 FRAC.SUN=PI*(GMT0-T.RISE)/T.SUN
41060 COSX=COS.ZEN*(SIN(TAU0)+U0*(EXP(U)-COS(TAU0)))/(1+U0*U0) :COSX2=COSX
41070 ALT.COSX=COS.ZEN*(U0*(EXP(-T.SUN/T.RELAX)+1))*EXP((T.SUN-24)/2)/(1+U0*U0):COSX3=ALT.COSX
41080 IF COSX=>ALT.COSX THEN GOTO MUF.CALC
41090 COSX=ALT.COSX
42000 MUF.CALC:
42010 MUF!=(1+SSN/250)*SQR(6+58*SQR(COSX))
42020 FVERT=MUF!
42030 MUF!=MUF!*(1-.1*EXP((T.SUN-24)/3))
42040 MUF!=MUF!*(1+(1-SGN(T.LAT)*SGN(R.LAT))*.1)
42050 MUF!=MUF!*(1-.1*(1+SGN(ABS(SIN(C.LAT))-COS(C.LAT))))
42060 FVERT1=MUF!:MUF!=M.FACT!*MUF!:
43000 IF MUF!<F.MUF THEN F.MUF=MUF!
43010 GOSUB ECUTOFF:'GOSUB PRINT.STUFF
43020 NEXT KHOP
43030 RETURN
45000 ECUTOFF: 'CALCULATE E LAYER CUTOFF FREQ
45010 E.FACT=.2:IF T.SUN=0 THEN GOTO ESCREEN
45020 IF T.SUN*FRAC.SUN=0 THEN GOTO ESCREEN
45030 E.COSX=COS.ZEN*SIN(PI*(GMT0-T.RISE)/T.SUN)
45040 IF E.COSX >.174 THEN E.FACT=E.COSX^.3 ELSE E.FACT=(FNACOS(E.COSX)*CNV-76)^-.4
45050 ESCREEN:
45060 E.SCREEN=(3.4+.00544*SSN)*E.FACT*SEC.EINC
45070 IF E.SCREEN>7 THEN E.LUF=(1.33*E.SCREEN-3.31)^2/7 ELSE E.LUF=.91*E.SCREEN -.37
45080 IF F.LUF<E.LUF THEN F.LUF=E.LUF
45090 IF E.CUTOFF<E.SCREEN THEN E.CUTOFF=E.SCREEN
45100 RETURN
47000 PRINT.STUFF:
47010 LPRINT USING "KHOP = ### GMT= ### Fv=#####.# Fv1=#####.# Mf= ##.### MUF= #####.# ";KHOP,GMT,FVERT,FVERT1,M.FACT!,MUF!
47020 LPRINT USING " E.SCREEN=#####.# E.LUF=#####.# E.CUTOFF=#####.# F.LUF= #####.# ";E.SCREEN,E.LUF,E.CUTOFF,F.LUF
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
47040 LPRINT "":RETURN
47050 LPRINT USING " T.NOON=###.# T.SUN=###.# T.RISE=###.# T.SET=###.# T.RELAX=###.# ";T.NOON,T.SUN,T.RISE,T.SET,T.RELAX
47060 LPRINT USING " COSX=###.## COSX1=###.## COSX2=###.## COSX3=###.##";COSX,COSX1,COSX2,COSX3
47070 LPRINT USING " TLAT=###.# TLON=###.# RLAT=###.# RLON=###.# GRNG=##### SSN=#### ";TLAT,TLON,RLAT,RLON,RE*GRNG,SSN
47080 LPRINT "":RETURN
48000 REM CALCULATION OF SUNSPOT NUMBER FROM SOLAR FLUX
48010 SSN=-103.7767+1.797429*SF-(3.384356E-03)*SF^2+(4.525515E-06)*SF^3
48020 SSN=INT(100*SSN+.5)/100
48030 RETURN
49000 REM SUBROUTINE TO CALCULATE RANGE AND BEARING
49010 Z1=TLAT*RPD:Z2=R.LAT*RPD:Z3=TLON*RPD:Z4=R.LON*RPD
49020 R7=SIN(Z1)*SIN(Z2)+COS(Z1)*COS(Z2)*COS(Z4-Z3)
49030 R8=FNACOS(R7):REM R8 IS DISTANCE IN RADIANS
49040 DX=R8*180/PI*69.041:REM RANGE IN STATUTE MILES
49050 C1=(SIN(Z2)-SIN(Z1)*R7)/(COS(Z1)*SIN(R8))
49060 IF C1>=1 THEN B0=0:GOTO 49080 ELSE IF C1<=-1 THEN B0=180/(180/PI):GOTO 49080
49070 B0=FNACOS(C1)
49080 B1=B0*180/PI
49090 IF SIN(Z3-Z4)<0 THEN B1=360-B1
49100 RETURN
50000 END SUB
51000 ' VIDEO GRAPHICS FOR QUICK BASIC
51010 ' EMULATION OF CALCOMP ROUTINES
51020 '
52000 SUB SCALE(XBEGIN,XEND,YBEGIN,YEND,XDAT(1),YDAT(1)) STATIC
52010 ' SCALING ROUTINE TO SCALE PLOTS TO THE UNITS OF
52020 ' THE DATA TO BE PLOTTED
52030 WINDOW (XBEGIN,YBEGIN)-(XEND,YEND)
52040 XDAT(1)=XEND-XBEGIN:YDAT(1)=YEND-YBEGIN
52050 XDAT(2)=XBEGIN:YDAT(2)=YBEGIN
52060 XDAT(3)=XEND:YDAT(3)=YEND
52070 END SUB
52080 '
53000 SUB AXES(NCOLOR,NX.BEGIN,NX.END,NY.BEGIN,NY.END,XDAT(1),YDAT(1),XTIC,YTIC) STATIC
53010 ' DRAW BOX WITH AXES AND TIC MARKS
53020 ' NX..,NY.. ARE DOT VALUES WHICH DEFINE THE BEGINNING & END
53030 ' OF EACH AXIS IN VIDEO DOT UNITS 0<=DX<=639, 0<=DY<=349
53040 ' Y VALUES ARE DEFINED WITH 0 AT BOTTOM OF SCREEN.
53050 ' XTIC,YTIC ARE THE TIC SPACINGS IN UNITS OF THE DATA TO BE
53060 ' PLOTTED VIA SCALE AND MYLINE. XDAT AND YDAT ARE SCALING DATA IN
53070 ' SAME UNITS FROM SCALE ROUTINE.
53080 ' NCOLOR IS THE FOREGROUND COLOR
53090 DEFINT I-N :COLOR NCOLOR
53100 IF NX.BEGIN <0 THEN NX.BEGIN=0 ELSE IF NX.BEGIN > 639 THEN NX.BEGIN=639
53110 IF NX.END <0 THEN NX.END =0 ELSE IF NX.END > 639 THEN NX.END =639
53120 IF NY.BEGIN <0 THEN NY.BEGIN=0 ELSE IF NY.BEGIN > 349 THEN NY.BEGIN=349
53130 IF NY.END <0 THEN NY.END =0 ELSE IF NY.END > 349 THEN NY.END =349
53140 VIEW (NX.BEGIN,349-NY.BEGIN)-(NX.END,349-NY.END),,NCOLOR
53150 DY.TIC=.01*ABS(XDAT(1)):DX.TIC=.01*ABS(YDAT(1))
53160 FOR X=XDAT(2) TO XDAT(3) STEP XTIC
53170 LINE (X,YDAT(2))- STEP (0, DX.TIC)
53180 LINE (X,YDAT(3))- STEP (0,-DX.TIC)
53190 NEXT X
53200 FOR Y=YDAT(2) TO YDAT(3) STEP YTIC
53210 LINE (XDAT(2),Y)- STEP ( DY.TIC,0)
53220 LINE (XDAT(3),Y)- STEP (-DY.TIC,0)
53230 NEXT Y
53240 END SUB
53250 '
54000 SUB MYLINE(NCOLOR,X(1),Y(1),NPTS,XDAT(1),YDAT(1)) STATIC
54010 DEFINT I-N
54020 FOR I=2 TO NPTS
54030 IF ABS( X(I)-X(I-1) ) >.3*XDAT(1) OR ABS( Y(I)-Y(I-1) ) >.3*YDAT(1) THEN 54050
54040 LINE (X(I-1),Y(I-1))-(X(I),Y(I)),NCOLOR
54050 NEXT I
54060 END SUB
55000 SUB UPPER.CASE(A$) STATIC
55010 L=LEN(A$):IF L=0 THEN EXIT SUB
55020 FOR I=1 TO L
55030 K=ASC(MID$(A$,I,1))
55040 IF K>=97 AND K<=122 THEN MID$(A$,I,1)=CHR$(K-32)
55050 NEXT I
55060 END SUB