1 COMMON A, AL, B, BASEONLY, C, C$, C1, CAT$, CC, CKT$, D, D$, DD, DIA, DIMN$, DMS, E, EO, EX$, F, F$, FD, FF, FQ, FRQ, G$, GO$, I, I$, L, LATLONG, LD, LL, LN, LS, LW, LX, MAX, MENU, MIN, MX, N, NN, NT, OV, P, PI, PROG$, Q, QQ, QU, R, RA, RC, T, T$, U, U$, UH, UL$, V$, VC, W, WHIP, WIRD, WW, X, X$, X1, XS, Z$, ZP, ZS
5 'OMMON EX$,PROG$
10 'works   Antenna Impedance Calculator - 19 MAR 08
20 KEY OFF
30 IF EX$=""THEN EX$="EXIT"
40 IF PROG$=""THEN GO$=EX$ ELSE GO$=PROG$
50 
60 PI=4*ATN(1)
70 '.....start
80 CLS
90 COLOR 15,2
100 PRINT " ANTENNA IMPEDANCE CALCULATOR";TAB(61);"by R.J.Dehoney IEEE ";
110 COLOR 1,0:PRINT STRING$(80,223);
120 COLOR 15,2:LOCATE CSRLIN-1,25:PRINT " (suggested by Gerd Wenz DJ4IB) "
130 COLOR 7,0
140 PRINT
150 GOTO 180
160 '.....clear to bottom
170 VIEW PRINT LN TO 24:CLS:VIEW PRINT:LOCATE LN:RETURN
180 '.....start
190 PRINT TAB(20);" This program calculates antenna impedance."
200 PRINT TAB(20);" ....Press 1 to continue or 0 to exit...."
210 Z$=INKEY$:IF Z$=""THEN 210
220 IF Z$="0"THEN CLS:RUN EX$
230 IF Z$="1"THEN CLS:GOTO 250
240 GOTO 220
250 PRINT " ANTENNA IMPEDANCE"
260 PRINT
270 PRINT " ÚÄÄÄÄÂÄÄÄÄÂÄCBÄÄ*"
280 PRINT " RA   LA   CA     "
290 PRINT " ÀÄÄÄÄÁÄÄÄÄÁÄÄÄÄÄ*"
300 PRINT
310 LN=CSRLIN:PRINT " Minimum frequency is 1 MHz"
320 INPUT " ENTER: Frequency (MHz)";F:B=300/F   'B=band in metres
330 LN=LN+1:GOSUB 160
340 IF F<1 THEN BEEP:GOSUB 160:GOTO 310
350 FQ=INT(F*100)/100:B=INT(B*100)/100
360 LOCATE CSRLIN-1:PRINT " Frequency =";FQ;"MHz  (";B;"metres )"
370 H=468/F*3.048000E-01/2
380 PRINT " Half Length of dipole=";H;"metres (";H/3.048000E-01 ;"feet )"
390 LN=CSRLIN:PRINT " Maximum element diameter =";H/25*10^3;"mm.";
400 INPUT " ENTER: diameter of elements (mm.)";Z
410 D=Z/10^3
420 IF Z>H/25*10^3 THEN BEEP:GOSUB 160:GOTO 390 ELSE LN=LN+1:GOSUB 160
430 IN=INT(D*3.936999E+01*1000)/1000
440 LOCATE CSRLIN-1:PRINT " Diameter of elements =";D;"metres (";IN ;"inches )"
450 PRINT
460 S=4*H/D:LS=LOG(S)/LOG(10)
470 RA=4.128800E+02*LS^2+7.407540E+03*S^(-2.388999E-02)-7.274080E+03
480 PRINT " RA =";RA;"ohms"
490 CA=2*H*(8.907499E-01/(LS^8.005999E-01-8.610000E-01)-2.541000E-02)
500 PRINT " CA =";CA;"pF"
510 LA=2*H*(1.481300E+02*(LS^1.011999)-6.188000E+01)
520 PRINT " LA =";LA;"nH"
530 CB=1.206739E+01*H/(LS-7.245000E-01)
540 PRINT " CB =";CB;"pF"
550 PRINT
560 FX=F*10^6
570 WX=FX*2*3.141592700000000
580 L1=LA*9.999999E-10 :C1=CA*9.999999E-13 :C2=CB*9.999999E-13 :Y1=WX*C1-1/WX/L1 :X1=-1/Y1
590 DENOM=RA^2+X1^2 :RE=RA*X1^2/DENOM :IM=RA^2*X1/DENOM-1/WX/C2
600 IF SGN(IM)=-1 THEN S$=" j -"ELSE S$=" j +"
610 PRINT USING " Impedance:      ####.##";RE;:PRINT S$;
620 PRINT USING " ##.## ohms";ABS(IM)
630 PRINT USING " Resistive part: ####.## ohms";RE
640 PRINT USING " Reactive part: +####.## ohms";IM
650 IF IM<0THEN C=-10^6/(2*PI*F*IM):PRINT USING " Capacitance:    ####.### pF";C
660 IF IM>0THEN L=IM/(2*PI*F):PRINT USING " Inductance=     ####.### nH";L*10^3
670 PRINT:COLOR 0,7
680 PRINT " Values not valid if height above ground is less than";B;"metres"
690 COLOR 7,0
700 '.....finish
710 GOSUB 720:CLS:GOTO 70
720 '.....PRT
730 KEY OFF:GOSUB 800:LOCATE 25,5:COLOR 0,2
740 PRINT " Send this page to:(1)Printer Queue? (2)Printout? ";
750 PRINT "(3)Next page? (1/2/3)";:COLOR 7,0
760 Z$=INKEY$:IF Z$<"1"OR Z$>"3"THEN 760 ELSE GOSUB 800
770 IF Z$="3"THEN RETURN
780 FOR I%=1 TO 24:FOR J%=1 TO 80:LPRINT CHR$(SCREEN(I%,J%));:NEXT J%:NEXT I%
790 IF Z$="2"THEN LPRINT CHR$(12) ELSE 730
800 LOCATE 25,1:PRINT STRING$(80,32);:RETURN
810 END
