This program was written by Tony Fegan VE3QF (ve3qf@amsat.org) who expanded a program originally published by I1ARZ.
The QBASIC/GWBASIC listing below can be converted to other dialects. When running pressing F10 calls subroutine at 460 which exits the program, F2 calls subroutine at 18 which sets default values for three loops and F3 prompts for user input of loop parameters.
You can download a ZIPped ascii file of this program by clicking on the icon at the foot of the page. Netscape users can click File|Save As| *.TXT to save the page to disk for editing.
180 CLS 190 COLOR 14, 1, 0 200 ON KEY(3) GOSUB 350 210 ON KEY(2) GOSUB 260 220 ON KEY(10) GOSUB 1510 230 KEY(3) ON 240 KEY(2) ON 250 KEY(10) ON 260 CLS 270 KEY(2) ON 280 DL = 1! 290 DD = 28 300 AF = 14! 310 BF = 18.1 320 HF = 29.7 330 P = 150 340 GOTO 600 350 CLS 360 COLOR 15, 1, 0 370 PRINT : PRINT " CALCULATION OF MAIN PARAMETERS" 380 PRINT " COPPER TUBING CIRCULAR SHORT LOOP ANTENNA" 390 COLOR 14, 1 400 PRINT 410 PRINT 420 KEY(3) ON 430 PRINT " Frequency A in MHz ["; : PRINT USING "##.#"; AF; : PRINT "]"; : INPUT ; " ", KAF 440 IF KAF > 0 THEN AF = KAF 450 PRINT 460 PRINT " Frequency B in MHz ["; : PRINT USING "##.#"; BF; : PRINT "]"; : INPUT ; " ", KBF 470 IF KBF > 0 THEN BF = KBF 480 PRINT 490 PRINT " Frequency C in MHz ["; : PRINT USING "##.#"; HF; : PRINT "]"; : INPUT ; " ", KHF 500 IF KHF > 0 THEN HF = KHF 510 PRINT 520 PRINT " Loop diameter in Meters ["; : PRINT USING "#.##"; DL; : PRINT "]"; : INPUT ; " ", KDL 530 IF KDL > 0 THEN DL = KDL 540 PRINT 550 PRINT " Tubing outside diameter in mm ["; : PRINT USING "##.#"; DD; : PRINT "]"; : INPUT ; " ", KDD 560 IF KDD > 0 THEN DD = KDD 570 PRINT 580 PRINT " Max transmitter power in Watts ["; : PRINT USING "####"; P; : PRINT "]"; : INPUT ; " ", KP 590 IF KP > 0 THEN P = KP 600 SS = DL * 3.1416 610 S = SS * 3.281 620 D = DD * .03937 630 CLS 640 LOCATE 23, 2 650 COLOR 12, 1, 0 660 PRINT " F2 - Use default parameters F3 - Change parameters F10 - QUIT" 670 LOCATE 1, 1 680 COLOR 15, 1, 0 690 PRINT 700 PRINT " CALCULATION OF MAIN PARAMETERS " 710 PRINT " COPPER TUBING CIRCULAR SHORT LOOP ANTENNA" 720 COLOR 14, 1, 0 730 PRINT 740 A = .07900001# * S ^ 2 750 L = 1.9 * 10 ^ -8 * S * (7.53 * LOG(96 * S / 3.1418 / D) / LOG(10) - 6.386) 760 UL = L * 10 ^ 6 770 PRINT " LOOP DIAMETER "; : PRINT DL; : PRINT "Meters" 780 PRINT " TUBING LENGTH "; : PRINT USING "##.##"; SS; : PRINT " Meters" 790 PRINT " TUBING OUTSIDE DIAMETER "; : PRINT DD; : PRINT "mm" 800 PRINT " LOOP INDUCTANCE "; : PRINT USING "##.###"; UL; : PRINT " uH" 810 PRINT " TRANSMIT PEAK POWER OUT "; : PRINT P; : PRINT " Watts" 820 PRINT 830 ARR = .0000000338# * AF ^ 4 * A ^ 2 840 BRR = .0000000338# * BF ^ 4 * A ^ 2 850 HRR = .0000000338# * HF ^ 4 * A ^ 2 860 COLOR 14, 1, 0 870 PRINT " A B C" 880 COLOR 11, 1, 0 890 PRINT " FREQUENCY in MHz "; : PRINT USING "###.#"; AF; : PRINT " MHz "; : PRINT BF; : PRINT "MHz "; : PRINT HF; : PRINT "MHz" 900 COLOR 14, 1, 0 910 APE = SS * AF / 3 920 BPE = SS * BF / 3 930 CPE = SS * HF / 3 940 PRINT " WAVELENGTH PERCENTAGE "; : PRINT USING "##.#"; APE; : PRINT " % "; : PRINT USING "##.#"; BPE; : PRINT " % "; 950 LOCATE , 62 960 PRINT USING "##.#"; CPE; : PRINT " %" 970 PRINT " RADIATION RESISTANCE "; : PRINT USING "#.###"; ARR; : PRINT " Ohms "; : PRINT USING "#.###"; BRR; : PRINT " Ohms"; 980 LOCATE , 62 990 PRINT USING "#.###"; HRR; : PRINT " Ohms" 1000 ARL = .000996 * SQR(AF) * (S / D) 1010 BRL = .000996 * SQR(BF) * (S / D) 1020 HRL = .000996 * SQR(HF) * (S / D) 1030 PRINT " CONDUCTOR LOSS "; : PRINT USING "#.###"; ARL; : PRINT " Ohms "; : PRINT USING "#.###"; BRL; : PRINT " Ohms"; 1040 LOCATE , 62 1050 PRINT USING "#.###"; HRL; : PRINT " Ohms" 1060 AE = ARR / (ARR + ARL) * 100 1070 BE = BRR / (BRR + BRL) * 100 1080 HE = HRR / (HRR + HRL) * 100 1090 PRINT " EFFICIENCY PERCENT "; : PRINT USING "##.##"; AE; : PRINT " % "; : PRINT USING "##.##"; BE; : PRINT " %"; 1100 LOCATE , 62 1110 PRINT USING "##.##"; HE; : PRINT " %" 1120 ADB = LOG(AE / 100) / LOG(10) * 10 1130 BDB = LOG(BE / 100) / LOG(10) * 10 1140 HDB = LOG(HE / 100) / LOG(10) * 10 1150 PRINT " EFFICIENCY IN dB "; : PRINT USING "##.##"; ADB; : PRINT " dB "; : PRINT USING "##.##"; BDB; : PRINT " dB"; 1160 LOCATE , 61 1170 PRINT USING "##.##"; HDB; : PRINT " dB" 1180 AXL = 2 * 3.14159 * AF * L * 10 ^ 6 1190 BXL = 2 * 3.14159 * BF * L * 10 ^ 6 1200 HXL = 2 * 3.14159 * HF * L * 10 ^ 6 1210 PRINT " LOOP REACTANCE "; : PRINT USING "###.##"; AXL; : PRINT " Ohms "; : PRINT USING "###.##"; BXL; : PRINT " Ohms"; 1220 LOCATE , 62 1230 PRINT USING "###.##"; HXL; : PRINT " Ohms" 1240 AQ = AXL / (ARR + ARL) / 2 1250 BQ = BXL / (BRR + BRL) / 2 1260 HQ = HXL / (HRR + HRL) / 2 1270 PRINT " QUALITY FACTOR "; : PRINT USING "####.#"; AQ; : PRINT " "; : PRINT USING "####.#"; BQ; 1280 LOCATE , 61 1290 PRINT USING "####.#"; HQ 1300 ADF = 2 * (ARR + ARL) / AXL * AF * 1000 1310 BDF = 2 * (BRR + BRL) / BXL * BF * 1000 1320 HDF = 2 * (HRR + HRL) / HXL * HF * 1000 1330 PRINT " BANDWIDTH "; : PRINT USING "###.#"; ADF; : PRINT " KHz "; : PRINT USING "###.#"; BDF; : PRINT " KHz"; 1340 LOCATE , 62 1350 PRINT USING "###.#"; HDF; : PRINT " KHz" 1360 AVC = SQR(P * AXL * AQ) 1370 BVC = SQR(P * BXL * BQ) 1380 HVC = SQR(P * HXL * HQ) 1390 PRINT " CAPACITOR VOLTAGE "; : PRINT USING "#####.#"; AVC; : PRINT " Volts "; : PRINT USING "#####.#"; BVC; : PRINT " Volts"; 1400 LOCATE , 61 1410 PRINT USING "#####.#"; HVC; : PRINT " Volts" 1420 ACT = 1 / (2 * 3.14159 * AF * AXL) * 10 ^ 6 1430 BCT = 1 / (2 * 3.14159 * BF * BXL) * 10 ^ 6 1440 HCT = 1 / (2 * 3.14159 * HF * HXL) * 10 ^ 6 1450 PRINT " TUNING CAPACITOR "; : PRINT USING "###.##"; ACT; : PRINT " pF "; : PRINT USING "###.##"; BCT; : PRINT " pF"; 1460 LOCATE , 61 1470 PRINT USING "###.##"; HCT; : PRINT " pF"; 1480 LOCATE 23, 1 1490 COLOR 14, 1, 0 1500 GOTO 1500 1510 GOTO 1520 1520 COLOR 15, 0, 0 1530 CLS 1540 SYSTEM 1550 END
Click here to download this listing as a ZIP file
Email GW0TQM
Carl GW0TQM's Magnetic loop page
Contributions comments and STL links welcomed.
Magloop home What? Using Building BASIC Software Links More reading and reports
Sign the Magloop Guestbook View the magloop Guestbook