100 ' ********************************* 110 ' * IBM PC BASIC VERSION A3.30 * 120 ' * FILE NAME "PF" * 130 ' * PROFILE DRAWING * 140 ' * 1987/10 I.KATO * 150 ' ********************************* 160 KEY OFF:CLS:SCREEN 9 170 COLOR 14 180 DEFDBL A,B,C,E,F,G,K,L,M,O,S 190 DIM U$(10),Y(200) 200 DATA "1 FREQUENCY","2 k(average)","3 k(minimum)","4 A-B DIST", "5 A HEIGHT" ,"6 B HEIGHT" ,"7 F ALTITD" ,"8 A-F DIST", "9 L ALTITD" ,"10 A-L DIST" 210 FOR I=1 TO 10:READ U$(I):NEXT 220 LOCATE 1,1:PRINT "[ITEM 8] PROFILE DRAWING ":COLOR 7 230 PRINT "Every possible route should be examined by using precise maps drawn on a scale of, for example, 1 to 50,000." 240 PRINT "A profile map of propagation path is drawn in order to study path clearance and the relation of path of direct and ground-reflected waves." 250 PRINT "Unsuitable path should be rejected at this stage. THe prospective path should undergo the detailed calculation specified in Item 23." 270 PRINT "Input data codes and their respective interpretations are common throughout thisprogramme as shown below. Altitude signifies the ground" 280 PRINT "height above the sea level.":PRINT 290 PRINT "SPAN DIST: span distance(km) from A to B" 300 PRINT "A(B)HEIGHT: altitude(m)+antenna(centre) height(m)" 310 PRINT " at point A(B)" 320 PRINT "F ALTITD: altitude(m) at reflection point F" 330 PRINT "F DIST: distance(km) from A to F(reflection point)" 340 PRINT "L ALTITD: altitude(m) at ridge point L" 350 PRINT "L DIST: distance(km) from A to L(ridge point)" 360 PRINT "k : coefficient of equivalent earth radius":PRINT 370 COLOR 3:LOCATE 21.1:PRINT "When many possible shielding ridges are found, only the most prospectively contributable one could be selected for the calculation." 380 COLOR 7 390 WINDOW SCREEN(0, 0)-(100,100) 400 VIEW(475,126)-(635,266),,5 410 RIDGE$="*":FLAG$="DIS" 420 VSH1=60:VMH1=50:VXL=50:VYL=50:VMH2=10:VEH2=30 430 VDF=2+19.3/50*94 440 GOSUB 8050 450 LINE( 2,VMH1)-(VDF,100),14:LINE(VDF,100)-(98,VMH2),14 460 LINE(15,100)-(20,85),2:LINE(20,88)-(25,100),2:PAINT(20,90),2,2 470 LINE(70,100)-(75,50),2:LINE(75,50)-(80,100),2:PAINT(75,60),2,2 480 LOCATE 10,79:PRINT "B":LOCATE 11,63:PRINT "SPAN DISTANCE" 490 LOCATE 13,61:PRINT "A":LOCATE 14,70:PRINT "L" 500 LOCATE 18,68:PRINT "F" 510 COLOR 6:LOCATE 23,15:PRINT "----- Are you ready ? Hit space key -----" 520 COLOR 7:Q$=INKEY$:IF Q$<>" " THEN 520 530 SCREEN 0:SCREEN 9:CLS:FLAG$="" 1000 ' *************** 1010 ' * data input * 1020 ' *************** 1030 COLOR 7:LOCATE 1,27:PRINT "[PROFILE DRAWING]" 1040 GOSUB 8000 1050 FOR I=0 TO 9:LOCATE 2+I:PRINT U$(I+1):NEXT 1060 GOSUB 5380:GOSUB 5200:GOSUB 5290 1070 GOSUB 4030:GOSUB 4200:GOSUB 4310:GOSUB 1360:GOSUB 1440:GOSUB 4420: GOSUB 4790:GOSUB 4980 1080 COLOR 6:LOCATE 23,10:PRINT "Do you correct any data (Y/N) ? ";: Y$=INPUT$(1) 1090 IF Y$<>"Y" AND Y$<>"y" AND Y$<>"N" AND Y$<>"n" THEN 1080 1100 COLOR 6:LOCATE 23,10:PRINT SPC(69) 1110 IF Y$="Y" OR Y$="y" THEN 1120 ELSE 2000 1120 COLOR 6:LOCATE 23,10:LINE INPUT "Input the item number(1-10) to be corrected ";X$ 1130 COLOR 7:LOCATE 23,10:PRINT SPC(69) 1140 NO=VAL(X$) 1150 IF NO<1 OR NO>10 THEN 1120 1160 IF NO=8 THEN COLOR 4:LOCATE 23,10:PRINT "Don't correct independently this data":FOR I=1 TO 5000:NEXT:COLOR 7:LOCATE 23,10:PRINT SPC(69):GOTO 1080 1170 LOCATE NO+1,14:PRINT SPC(8) 1180 IF NO=4 THEN GOSUB 4030:FOR I= 7 TO 8:LOCATE I+1,14:PRINT SPC(8):NEXT: GOSUB 1360:GOSUB 1400:GOSUB 4420 1190 IF NO=5 THEN GOSUB 4200:FOR I= 7 TO 8:LOCATE I+1,14:PRINT SPC(8):NEXT: GOSUB 1360:GOSUB 1420:GOSUB 4420 1200 IF NO=6 THEN GOSUB 4310:FOR I= 7 TO 8:LOCATE I+1,14:PRINT SPC(8):NEXT: GOSUB 1360:GOSUB 1420:GOSUB 4420 1210 IF NO=7 THEN LOCATE 9,14:PRINT SPC(8):GOSUB 4580 1220 IF NO=9 THEN GOSUB 4790:GOSUB 1410:GOSUB 1280 1230 IF NO=10 THEN GOSUB 1430:GOSUB 4980 1240 IF NO=1 THEN GOSUB 5380 1250 IF NO=2 THEN GOSUB 5200 1260 IF NO=3 THEN GOSUB 5290 1270 GOTO 1080 1280 LINE( 2,VMH1)-(VDF,VHF),7,,&H8888 1290 LINE(VDF,VHF)-(98,VMH2),7,,&H8888 1300 IF VHF>=99 THEN 1340 1310 LINE(VDF-5,100)-(VDF,VHF),2 1320 LINE(VDF,VHF)-(VDF+5,100),2 1330 PAINT(VDF,99),2,2 1340 LOCATE (10+VHF)/8-1,(180+VDF*2)/8+1:PRINT "F" 1350 RETURN 1360 ' 1370 IF H1>=H2 THEN VSH1=30:VMH1=10:VMH2=100-H2/H1*90:VEH2=VMH2+10:MAXH=H1 1380 IF H1< H2 THEN VEH2=30:VMH2=10:VMH1=100-H1/H2*90:VSH1=VMH1+10:MAXH=H2 1390 RETURN 1400 ' 1410 VDL=2+D1/D*94:D2=D-D1 1420 ' 1430 VXL=VDL:VYL=100-HS/MAXH*90 1440 CLS:GOSUB 8000 1450 RETURN 2000 ' *************** 2010 ' * clearance * 2020 ' *************** 2030 H0=H1:IF H1>H2 THEN H0=H2 2040 ' fresnel zone radius 2050 FOR I=1 TO 2:AK(I)=1/(2*K(I)*6370)*1000:NEXT 2060 IF RIDGE$="" THEN FR=SQR(WL*D/4) ELSE FR=SQR(WL*D1*D2/D) 2070 ' direct wave clearance 2080 FOR I=1 TO 2:GL(I)=H1-DF/D*(H1-H2)-DF*(D-DF)*AK(I): IF RIDGE$<>"" THEN CL(I)=H1-D1/D*(H1-H2)-D1*D2*AK(I)-HS 2090 NEXT 2100 ' reflected wave clearance 2110 IF RIDGE$="" THEN 3000 2130 IF D1=DF THEN FOR I=1 TO 2:CLH(I)=H2-D2/(D-DF)*(H2-HF)-D2*((D-DF)-D2)*AK(I)-HS:NEXT 3000 '****************** 3010 '* PROFILE DRAW * 3020 '****************** 3030 COLOR 7:LOCATE 1,1:PRINT SPC(79) 3040 ' ----- k=max ----- 3050 COLOR 3:LOCATE 13, 1:PRINT "[DIRECT WAVE]":COLOR 7 3060 LOCATE 14, 1:PRINT "CLEARANCE":LOCATE 14,10:IF RIDGE$="" THEN PRINT USING "##,###.#m";GL(1) ELSE PRINT USING "##,###.#m";CL(1) 3070 IF GL(1)<0 THEN COLOR 4:LOCATE 15,1:PRINT "PATH sink under earth": LOCATE 16,1:PRINT "surface. This span": LOCATE 17,1:PRINT "is not line-of-sight.":GOTO 3160 3080 LOCATE 15, 1:PRINT "PATH is":LOCATE 15,10:COLOR 2 3090 IF -100=0 THEN PRINT "acceptable.":GOTO 3130 3120 IF CL(1)<=-100 THEN COLOR 12:PRINT "not acceptable.":COLOR 11: LOCATE 16, 1:PRINT "Antenna height should":LOCATE 17, 1:PRINT "be elevated more than":LOCATE 18, 1:PRINT "100 m." 3130 COLOR 14:LOCATE 19, 1:PRINT "[REFLECTED WAVE]":COLOR 7 3140 LOCATE 20, 1:PRINT "CLEARANCE":LOCATE 20,10:IF RIDGE$="" THEN PRINT " ----" ELSE PRINT USING "##,###.#m";CLH(1) 3150 LOCATE 21, 1:PRINT "Path is":LOCATE 21,10:IF CLH(1)<0 THEN COLOR 2: PRINT "intercepted." ELSE COLOR 4:PRINT "through." 3160 COLOR 7:C=12.74*K(1):GOSUB 7000 3165 LOCATE 2,44:PRINT "PROFILE":LOCATE 2,54:PRINT USING "k=##.##";K(1) 3170 COLOR 6:LOCATE 23,30:PRINT "----- To proceed: Hit space key -----" 3180 COLOR 7:Q$=INKEY$:IF Q$<>" " THEN 3180 3190 LOCATE 23,30:PRINT SPC(49) 3300 ' ----- k=min ----- 3310 CLS:FOR I=1 TO 22:LOCATE I,23:PRINT SPC(57):NEXT: FOR I=13 TO 22:LOCATE I,1:PRINT SPC(79):NEXT 3320 COLOR 3:LOCATE 13, 1:PRINT "[DIRECT WAVE]":COLOR 7 3330 LOCATE 14, 1:PRINT "CLEARANCE":LOCATE 14,10:IF RIDGE$="" THEN PRINT USING "##,###.#m";GL(2) ELSE PRINT USING "##,###.#m";CL(2) 3340 IF GL(2)<0 THEN COLOR 4:LOCATE 15,1:PRINT "PATH sink under earth": LOCATE 16,1:PRINT "surface. This span": LOCATE 17,1:PRINT "is not line-of-sight.":GOTO 3430 3350 LOCATE 15, 1:PRINT "PATH is":LOCATE 15,10:COLOR 2 3360 IF -100=0 THEN PRINT "acceptable.":GOTO 3400 3390 IF CL(2)<=-100 THEN COLOR 12:PRINT "not acceptable.":COLOR 11: LOCATE 16, 1:PRINT "Antenna height should":LOCATE 17, 1:PRINT "be elevated more than":LOCATE 18, 1:PRINT "100 m." 3400 COLOR 14:LOCATE 19, 1:PRINT "[REFLECTED WAVE]":COLOR 7 3410 LOCATE 20, 1:PRINT "CLEARANCE":LOCATE 20,10:IF RIDGE$="" THEN PRINT " ----" ELSE PRINT USING "##,###.#m";CLH(2) 3420 LOCATE 21, 1:PRINT "PATH is":LOCATE 21,10:IF CLH(2)<0 THEN COLOR 2: PRINT "intercepted." ELSE COLOR 4:PRINT "through." 3430 COLOR 7:C=12.74*K(2):GOSUB 7150 3440 COLOR 7:LOCATE 2,44:PRINT "PROFILE":LOCATE 2,54:PRINT USING "k=##.##";K(2) 3530 COLOR 6:LOCATE 23,30:PRINT "Do you continue the work (Y/N) ? ";: Y$=INPUT$(1) 3540 IF Y$<>"Y" AND Y$<>"y" AND Y$<>"N" AND Y$<>"n" THEN 3530 3550 COLOR 7:LOCATE 23,30:PRINT SPC(49) 3560 IF Y$="Y" OR Y$="y" THEN SCREEN 0:CLS:SCREEN 9:GOTO 220 3570 RUN "ME" 4000 ' ******************** 4010 ' * data input sub * 4020 ' ******************** 4030 ' span distance 4040 COLOR 6:LOCATE 5,1:PRINT U$(4) 4050 LINE( 2, 7)-(98, 7),6,,&H8888 4060 LINE( 2, 2)-( 2,12),6 4070 LINE(98, 2)-(98,12),6 4080 COLOR 6:LOCATE 3,28:PRINT "SPAN DISTANCE" 4090 COLOR 6:LOCATE 22,7:PRINT "Input A-B SPAN DISTANCE (km) ";:LINE INPUT X$ 4100 COLOR 7:LOCATE 22,7:PRINT SPC(73) 4110 D=VAL(X$) 4120 IF D<1 OR D>100 THEN 4030 4130 LOCATE 5,15:PRINT USING "###.#km";D 4140 LOCATE 5, 1:PRINT U$(4) 4150 LINE( 2, 7)-(98, 7),0 4160 LINE( 2, 2)-( 2,12),0 4170 LINE(98, 2)-(98,12),0 4180 LOCATE 3,28:PRINT SPC(15) 4190 RETURN 4200 ' A point height 4210 COLOR 6:LOCATE 6,1:PRINT U$(5) 4220 LINE( 2,VMH1)-(2,100),6 4230 COLOR 6:LOCATE 22,7:PRINT "Input A HEIGHT (m) ";:LINE INPUT X$ 4240 COLOR 7:LOCATE 22,7:PRINT SPC(73) 4250 H1=VAL(X$) 4260 IF H1<1 THEN 4200 4270 LOCATE 6,14:PRINT USING "####.#m";H1 4280 LOCATE 6,1:PRINT U$(5) 4290 LINE( 2,VMH1)-(2,100),0 4300 RETURN 4310 ' B point height 4320 COLOR 6:LOCATE 7,1:PRINT U$(6) 4330 LINE(98,VMH2)-(98,100),6 4340 COLOR 6:LOCATE 22,7:PRINT "Input B HEIGHT (m) ";:LINE INPUT X$ 4350 COLOR 7:LOCATE 22,7:PRINT SPC(73) 4360 H2=VAL(X$) 4370 IF H2<1 THEN 4340 4380 LOCATE 7,14:PRINT USING "####.#m";H2 4390 LOCATE 7, 1:PRINT U$(6) 4400 LINE(98,VMH2)-(98,100),0 4410 RETURN 4420 ' reflection point 4430 HH=0:DM=D:GOSUB 6000:DF=DH:VDF=2+DF/D*94 4440 COLOR 6:LOCATE 8,1:PRINT U$(7) 4450 LINE( 2,VMH1)-(VDF,100),6 4460 LINE(VDF,100)-(98,VMH2),6 4470 LOCATE 110/8-1,(180+VDF*2)/8+1:PRINT "F" 4480 COLOR 3:LOCATE 20,1:PRINT "Obtain a ground reflection point (F) between point A and B" 4485 COLOR 6:LOCATE 22,1:PRINT "Input Altitude(m) at the point";:COLOR 2: PRINT USING "###.#km";DF;:COLOR 6:LINE INPUT " away from point A ";X$ 4490 COLOR 7:FOR I=20 TO 22:LOCATE I,1:PRINT SPC(79):NEXT 4500 HH=VAL(X$):IF HH>=H1 OR HH>=H2 THEN 4480 ELSE GOSUB 6000 4510 LINE( 2,VMH1)-(VDF,100),0 4520 LINE(VDF,100)-(98,VMH2),0 4530 LOCATE 110/8-1,(180+VDF*2)/8+1:PRINT " " 4540 IF ABS(DF-DH)>.1 THEN 4550 ELSE HF=HH:GOTO 4670 4550 COLOR 3:LOCATE 20,1:PRINT "Point F is";:COLOR 2:PRINT USING "###.#km";DH;: COLOR 3:PRINT " away from point A":LOCATE 22,1:COLOR 6: LINE INPUT "Input Altitude(m) at the point F ";X$ 4560 COLOR 7:FOR I=20 TO 22:LOCATE I,1:PRINT SPC(79):NEXT 4570 HH=VAL(X$):IF HH>=H1 OR HH>=H2 THEN 4550 ELSE DF=DH:GOSUB 6000:GOTO 4540 4580 COLOR 6:LOCATE 8, 1:PRINT U$(7) 4590 LINE( 2,VMH1)-(VDF,VHF),6 4600 LINE(VDF,VHF)-(98,VMH2),6 4610 COLOR 6:LOCATE 22,1:LINE INPUT "Input Altitude(m) at the point F ";X$ 4620 COLOR 7:LOCATE 22,1:PRINT SPC(79) 4640 CLS:GOSUB 8000 4650 HH=VAL(X$):IF HH>=H1 OR HH>=H2 THEN 4610 ELSE DM=D:GOSUB 6000:GOTO 4540 4660 ' 4670 DF=DH:VDF=2+DF/D*94:VHF=100-HF/MAXH*90 4680 LOCATE 8,14:PRINT USING "####.#m";HF 4690 LOCATE 9,15:PRINT USING "###.#km";DF 4700 LOCATE 8, 1:PRINT U$(7) 4710 LOCATE (10+VHF)/8-1,(180+VDF*2)/8+1:PRINT "F" 4720 LINE( 2,VMH1)-(VDF,VHF),0:LINE( 2,VMH1)-(VDF,VHF),7,,&H8888 4730 LINE(VDF,VHF)-(98,VMH2),0:LINE(VDF,VHF)-(98,VMH2),7,,&H8888 4740 IF VHF>=99 THEN RETURN 4750 LINE(VDF-5,100)-(VDF,VHF),2 4760 LINE(VDF,VHF)-(VDF+5,100),2 4770 PAINT(VDF,99),2,2 4780 RETURN 4790 ' ridge 4800 COLOR 6:LOCATE 10, 1:PRINT U$(9) 4810 LINE(VXL,VYL)-(VXL,100),6 4820 COLOR 6:LOCATE 22,1:LINE INPUT "Input Altitude(m) at the ridge L (Input 0 in case nothing ridge) ";X$ 4830 COLOR 7:LOCATE 22,1:PRINT SPC(79) 4840 HS=VAL(X$) 4850 LOCATE 10,14:IF HS=0 THEN PRINT " -----" ELSE PRINT USING "####.#m";HS 4860 LOCATE 10, 1:PRINT U$(9) 4870 IF HS=0 THEN 4880 ELSE RETURN 4880 RIDGE$="":DR1=0:DR2=0:VXL=0:VYL=0:LOCATE 11,14:PRINT " ----- " 4890 CLS:GOSUB 8000 4900 LINE( 2,VMH1)-(VDF,VHF),7,,&H8888 4910 LINE(VDF,VHF)-(98,VMH2),7,,&H8888 4920 IF VHF>=99 THEN 4960 4930 LINE(VDF-5,100)-(VDF,VHF),2 4940 LINE(VDF,VHF)-(VDF+5,100),2 4950 PAINT(VDF,99),2,2 4960 LOCATE (10+VHF)/8-1,(180+VDF*2)/8+1:PRINT "F" 4970 GOTO 1080 4980 RIDGE$="*":VHS=100-HS/MAXH*90 4990 COLOR 6:LOCATE 11, 1:PRINT U$(10) 5000 LINE( 2,2)-( 2,12),6 5010 LINE(VXL,2)-(VXL,12),6 5020 LINE(2, 7)-(VXL, 7),6,,&H8888 5030 COLOR 6:LOCATE 3,28:PRINT "A-L" 5040 LOCATE 22, 1:PRINT "Input Distance(km) between point A and ridge L ";:LINE INPUT X$ 5050 COLOR 7:LOCATE 22, 1:PRINT SPC(79) 5060 D1=VAL(X$):D2=D-D1:VDL=2+D1/D*94 5070 IF D1>D THEN 5040 5080 LOCATE 11,14:PRINT USING "####.#km";D1 5090 LOCATE 11, 1:PRINT U$(10) 5100 LOCATE 3,28:PRINT SPC(20) 5110 CLS:VXL=VDL:VYL=VHS:GOSUB 8000 5120 LINE( 2,VMH1)-(VDF,VHF),7,,&H8888 5130 LINE(VDF,VHF)-(98,VMH2),7,,&H8888 5140 IF VHF>=99 THEN 5180 5150 LINE(VDF-5,100)-(VDF,VHF),2 5160 LINE(VDF,VHF)-(VDF+5,100),2 5170 PAINT(VDF,99),2,2 5180 LOCATE (10+VHF)/8-1,(180+VDF*2)/8+1:PRINT "F" 5190 RETURN 5200 ' k (max) 5210 COLOR 6:LOCATE 3,1:PRINT U$(2) 5220 COLOR 6:LOCATE 22,7:PRINT "Input k (average value) ";: LINE INPUT X$ 5230 COLOR 7:LOCATE 22,7:PRINT SPC(73) 5240 IF MID$(X$,2,1)="/" THEN K(1)=VAL(LEFT$(X$,1))/VAL(RIGHT$(X$,1)) ELSE K(1)=VAL(X$) 5250 IF K(1)<1 OR K(1)>3 THEN 5220 5260 LOCATE 3,15:PRINT USING "##.##";K(1) 5270 LOCATE 3, 1:PRINT U$(2) 5280 RETURN 5290 ' k (min) 5300 COLOR 6:LOCATE 4,1:PRINT U$(3) 5310 COLOR 6:LOCATE 22,7:PRINT "Input k(minimum value) ";: LINE INPUT X$ 5320 COLOR 7:LOCATE 22,7:PRINT SPC(73) 5330 IF MID$(X$,2,1)="/" THEN K(2)=VAL(LEFT$(X$,1))/VAL(RIGHT$(X$,1)) ELSE K(2)=VAL(X$) 5340 IF K(2)=0 OR K(2)>1 THEN 5310 5350 LOCATE 4,15:PRINT USING "##.##";K(2) 5360 LOCATE 4, 1:PRINT U$(3) 5370 RETURN 5380 ' FREQUENCY 5390 COLOR 6:LOCATE 2,1:PRINT U$(1) 5400 COLOR 6:LOCATE 22,7:PRINT "Input FREQUENCY BAND (GHz) (2,4,5,6,7,8,11,15) ";:LINE INPUT X$ 5410 F=VAL(X$) 5420 IF F<>INT(F) OR F<2 OR F=3 OR (F>8 AND F<11) OR (F>11 AND F<15) OR F>15 THEN LOCATE 22,7:PRINT SPC(73):GOTO 5400 5430 IF F=6 THEN 5440 ELSE 5460 5440 COLOR 6:LOCATE 23,7:INPUT "input L(lower band) or U(upper band) L/U ";B$ 5450 IF B$<>"U" AND B$<>"u" AND B$<>"L" AND B$<>"l" THEN LOCATE 23,7: PRINT SPC(70):GOTO 5440 5460 COLOR 7:LOCATE 22,7:PRINT SPC(73):LOCATE 23,7:PRINT SPC(70) 5470 IF F=2 THEN FQ=2.002 5480 IF F=4 THEN FQ=4.004 5490 IF F=5 THEN FQ=4.7 5500 IF (F=6 AND B$="L") OR (F=6 AND B$="l") THEN FQ=6.175 5510 IF (F=6 AND B$="U") OR (F=6 AND B$="u") THEN FQ=6.77 5520 IF F=7 THEN FQ=7.575 5530 IF F=8 THEN FQ=8 5540 IF F=11 THEN FQ=11.2 5550 IF F=15 THEN FQ=14.825 5560 LOCATE 2,15:PRINT USING "##.#GHz";FQ 5570 WL=3*100/FQ 5580 LOCATE 2, 1:PRINT U$(1) 5590 RETURN 6000 ' ************************** 6010 ' * reflection point sub * 6020 ' ************************** 6030 P=H1-HH:Q=H2-HH 6040 C=(P-Q)/(P+Q) 6050 M=.5*DM*DM/(6370*K(1)*2*(P+Q))*1000 6060 K=C/(1+M) 6070 B=K: GOSUB 6160 6080 O=S:N=10^-4 6090 B=K+N:GOSUB 6160 6100 L=K:K=L-N*O/(S-O) 6110 IF ABS(L-K)>=1/10^8 THEN 6070 6120 DH=DM*(1+K)/2 6130 DH=INT((DH+.0005)*1000)/1000 6140 RETURN 6150 ' 6160 ' * cubic equation sub * 6170 S=(B*B-(1+M)/M)*B+C/M 6180 RETURN 7000 ' ********************** 7010 ' * profile draw sub * 7020 ' ********************** 7030 ' Y=(D-X)*X/(12.74*K) 7040 ' span scale 7050 IF D<=30 THEN GD=50 7060 IF D>30 AND D<60 THEN GD=70 7070 IF D>=60 THEN GD=120 7080 YM=(GD/2*GD/2)/(12.74*K(1)) 7090 ' height scale 7100 IF H1<=500 AND H2<=500 THEN FLAG$="1":YW=INT(YM* 5*(100/GD)^2): GOTO 7140 7110 IF H1<=1200 AND H2<=1200 THEN FLAG$="2":YW=INT(YM*10*(100/GD)^2): GOTO 7140 7120 IF H1<=2400 AND H2<=2400 THEN FLAG$="3":YW=INT(YM*20*(100/GD)^2): GOTO 7140 7130 IF H1>2400 OR H2>2400 THEN FLAG$="4":YW=INT(YM*40*(100/GD)^2) 7140 CLS:VIEW(180,10)-(380,110),,0 7150 FOR I=1 TO 14:LOCATE I,23:PRINT SPC(26):NEXT 7160 VIEW(216, 4)-(600,294),,5 7170 WINDOW SCREEN(0,-YW)-(GD,0) 7190 ' ground surface 7200 FOR X=0 TO GD 7210 Y=-(GD-X)*X/C 7220 IF X=0 THEN PSET(X,Y) ELSE LINE-(X,Y),2 7230 Y(X)=Y 7240 NEXT 7250 PAINT(GD/2,Y(GD/2)+20),2,2 7270 ' path 7280 L1=INT(GD/2-D/2):L2=INT(GD/2+D/2):LR=INT(L1+D1) 7290 LINE(L1,Y(L1)-H1)-(L1-1,Y(L1-1)),2 7300 LINE(L1,Y(L1)-H1)-(L1+1,Y(L1+1)),2 7310 PAINT(L1,Y(L1)-H1/2),2,2 7320 AP=L1/GD*(600-216):AQ=(YW-ABS(Y(L1)-H1))/YW*(176-10) 7330 LOCATE (2+AQ)/8,(216+AP)/8:PRINT "A" 7340 LINE(L2,Y(L2)-H2)-(L2-1,Y(L2-1)),2 7350 LINE(L2,Y(L2)-H2)-(L2+1,Y(L2+1)),2 7360 PAINT(L2,Y(L2)-H2/2),2,2 7370 BP=L2/GD*(600-216):BQ=(YW-ABS(Y(L2)-H2))/YW*(176-10) 7380 LOCATE (2+BQ)/8,(216+BP)/8:PRINT "B" 7390 IF HS=0 THEN 7460 7400 LINE(LR,Y(LR)-HS)-(LR-1,Y(LR-1)),2 7410 LINE(LR,Y(LR)-HS)-(LR+1,Y(LR+1)),2 7420 PAINT(LR,Y(LR)-HS/2),2,2 7430 LP=(L1+D1)/GD*(600-216):LQ=(YW-ABS(Y(L1+D1)-HS))/YW*(176-10) 7440 IF ABS(Y(LR)-HS)>=YW THEN LP=LP+8:LQ=6 7450 LOCATE (2+LQ)/8,(216+LP)/8:PRINT "L" 7460 LINE(L1+DF,Y(L1+DF)-HF)-(L1+DF-1,Y(L1+DF-1)),2 7470 LINE(L1+DF,Y(L1+DF)-HF)-(L1+DF+1,Y(L1+DF+1)),2 7480 PAINT(L1+DF,Y(L1+DF)-HF/2),2,2 7490 FP=(L1+DF)/GD*(600-216):FQ=(YW-ABS(Y(L1+DF)-HF))/YW*(176-10) 7500 LOCATE (2+FQ)/8,(216+FP)/8:PRINT "F" 7510 ' height scale 7515 IF K(1)>4/3 THEN L=3 ELSE L=4 7520 ON VAL(FLAG$) GOTO 7530,7610,7690,7770 7530 FOR J=1 TO 14 7540 FOR X=0 TO GD 7550 Y=-((GD-X)*X/C+J*50) 7560 IF X=0 THEN PSET(X,Y) 7570 IF J/2=INT(J/2) THEN LINE-(X,Y),7,,&HAAAA ELSE LINE-(X,Y),7,,&H8888 7580 NEXT X,J 7590 FOR J=22 TO 74 STEP 52:FOR I=0 TO 5:LOCATE L+I*3,J+1:PRINT ABS(I*100-600): NEXT I,J 7600 GOTO 7840 7610 FOR J=1 TO 28 7620 FOR X=0 TO GD 7630 Y=-((GD-X)*X/C+J*50) 7640 IF X=0 THEN PSET(X,Y) 7650 IF J/2=INT(J/2) THEN LINE-(X,Y),7,,&HAAAA ELSE LINE-(X,Y),7,,&H8888 7660 NEXT X,J 7670 FOR J=22 TO 74 STEP 52:FOR I=0 TO 5:LOCATE L+I*3,J+1:PRINT ABS(I*200-1200): NEXT I,J 7680 GOTO 7840 7690 FOR J=1 TO 28 7700 FOR X=0 TO GD 7710 Y=-((GD-X)*X/C+J*100) 7720 IF X=0 THEN PSET(X,Y) 7730 IF J/2=INT(J/2) THEN LINE-(X,Y),7,,&HAAAA ELSE LINE-(X,Y),7,,&H8888 7740 NEXT X,J 7750 FOR J=22 TO 74 STEP 52:FOR I=0 TO 5:LOCATE L+I*3,J+1:PRINT ABS(I*400-2400): NEXT I,J 7760 GOTO 7840 7770 FOR J=1 TO 28 7780 FOR X=0 TO GD 7790 Y=-((GD-X)*X/C+J*200) 7800 IF X=0 THEN PSET(X,Y) 7810 IF J/2=INT(J/2) THEN LINE-(X,Y),7,,&HAAAA ELSE LINE-(X,Y),7,,&H8888 7820 NEXT X,J 7830 FOR J=22 TO 74 STEP 52:FOR I=0 TO 5:LOCATE L+I*3,J+1:PRINT ABS(I*800-4800):NEXT I,J 7840 ' distance 7850 FOR I=0 TO GD STEP 10:LINE(I,-YW)-(I,Y(I)),7:NEXT 7860 FOR I=0 TO GD/10:LOCATE 22,25+I*500/GD:PRINT USING "###";I*10:NEXT 7870 ' direct wave 7880 IF INDEX$="CUT" THEN CO=4 ELSE CO=3 7890 LINE(L1,Y(L1)-H1)-(L2,Y(L2)-H2),CO 7900 ' reflective wave 7910 LINE(L1,Y(L1)-H1)-(L1+DF,Y(L1+DF)-HF),14: LINE(L2,Y(L2)-H2)-(L1+DF,Y(L1+DF)-HF),14 7920 RETURN 8000 ' *********************** 8010 ' * data input sub(2) * 8020 ' *********************** 8030 WINDOW SCREEN(0, 0)-(100,100) 8040 VIEW(180,18)-(380,192),,5 8050 LINE( 2,VMH1)-(98,VMH2),7 8060 LINE( 0, 100)-( 0,VSH1),2 8070 LINE( 0,VSH1)-( 2,VMH1),2 8080 LINE( 2,VMH1)-(10, 100),2 8090 LINE( 0, 100)-(10, 100),2 8100 IF VMH1>=99 THEN 8110 ELSE PAINT(2,99),2,2 8110 IF FLAG$="" THEN LOCATE (10+VMH1)/8-1,182/8+1:PRINT "A" 8120 IF RIDGE$="" THEN 8190 8130 LINE(VXL-5,100)-(VXL, VYL),2 8140 LINE(VXL, VYL)-(VXL+5,100),2 8150 LINE(VXL-5,100)-(VXL+5,100),2 8160 PAINT(VXL,99),2,2 8170 IF FLAG$<>"" THEN 8190 ELSE 8180 8180 IF VYL<1 THEN LOCATE 2,(180+VXL*2)/8+1:PRINT "L" ELSE LOCATE (10+VYL)/8-1,(180+VXL*2)/8+1:PRINT "L" 8190 LINE( 90, 100)-( 98,VMH2),2 8200 LINE( 98,VMH2)-(100,VEH2),2 8210 LINE(100,VEH2)-(100, 100),2 8220 LINE( 90, 100)-(100, 100),2 8230 IF VMH2>=99 THEN 8240 ELSE PAINT(98,99),2,2 8240 IF FLAG$="" THEN LOCATE (10+VMH2)/8-1,378/8+1:PRINT "B" 8250 RETURN