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
10 'IMPEDCCT - Reactance/Resistance Circuits - 08 MAR 97 rev. 16 MAR 08
20 IF EX$=""THEN EX$="EXIT"
30 CLS:KEY OFF
40 COLOR 7,0,1
50 U$="####,###.####"
60 PI=3.141592
70 N=11 'number of arrays
80 DIM I(N),I$(N,2),FLAG(N)
90 RESTORE
100 DATA Frequency,MHz,Capacitance,pF,Capacitive Reactance,-,Inductance,>H
110 DATA Inductive Reactance,-,Resistance R- Series Circuit,-
120 DATA Impedance   - Series Circuit,-,Phase Angle - Series Circuit,
130 DATA Resistance R- Parallel Circuit,-
140 DATA Impedance   - Parallel Circuit,-,Phase Angle - Parallel Circuit,
150 FOR Z=1 TO N:READ I$(Z,1),I$(Z,2):NEXT Z
160 FOR Z=1 TO N:I$(Z,1)=I$(Z,1)+STRING$(35-LEN(I$(Z,1)),"."):NEXT Z
170 '
180 '.....start
190 FOR Z=1 TO N:I(Z)=O:NEXT Z      'clear array
200 COLOR 15,2
210 PRINT " IMPEDANCE - REACTANCE/RESISTANCE CIRCUITS";
220 PRINT TAB(57);"by George Murphy VE3ERP ";
230 COLOR 1,0:PRINT STRING$(80,223);
240 COLOR 7,0
250 GOSUB 1620
260 LOCATE 10
270 FOR Z=1 TO N:LOCATE ,20:PRINT I$(Z,1)
280 IF Z<12 THEN LOCATE CSRLIN-1,53-LEN(I$(Z,2)):PRINT "(";I$(Z,2);;")"
290 NEXT Z
300 PRINT
310 COLOR 0,7:LOCATE ,20:PRINT " Press 1 to continue or 0 to EXIT ";:COLOR 7,0
320 Z$=INKEY$:IF Z$=""THEN 320
330 IF Z$="0"THEN CLS:RUN EX$
340 IF Z$="1"THEN 370
350 GOTO 320
360 '
370 CLS:GOSUB 1500
380 PRINT:LN=CSRLIN
390 LOCATE LN
400 FOR Z=1 TO N:LOCATE ,22:PRINT I$(Z,1)
410 IF Z<12 THEN LOCATE CSRLIN-1,53-LEN(I$(Z,2)):PRINT "(";I$(Z,2);;")"
420 NEXT Z
430 K=6
440 LOCATE LN-1,50:PRINT STRING$(29,32):LOCATE LN-1
450 COLOR 14:PRINT " ENTER: ";I$(K,1);;" (0 if unknown)...";"(;"+I$(K,2)+";);";";
460 INPUT I(K):COLOR 7
470 IF I(K)<>0 THEN 500
480 IF K=6 THEN K=9 ELSE IF K=9 THEN K=6
490 GOTO 440
500 LOCATE LN-1+K,56:PRINT USING U$;I(K)
510 FOR Z=1 TO N:LOCATE LN-1+Z,15:PRINT "< ";CHR$(Z+96);;" >";:NEXT Z
520 A$="SERIES":B$="PARALLEL"
530 IF K=6 THEN A=LN-1+9:B=LN-1+11
540 IF K=9 THEN A=LN-1+6:B=LN-1+8 :SWAP A$,B$
550 VIEW PRINT A TO B:CLS:VIEW PRINT
560 LOCATE LN-1:COLOR 14
570 PRINT " Press a letter in < > below to enter SOUGHT component...";
580 PRINT STRING$(20,32):COLOR 7
590 Z$=INKEY$:IF Z$=""THEN 590
600 Y=ASC(Z$)-96
610 IF Y<1 OR Y>N THEN 590
620 IF K=6 AND Y>=9 AND Y<=N  THEN 590
630 IF K=9 AND Y>=6 AND Y<=8  THEN 590
640 FLAG(Y)=1
650 LOCATE LN-1+Y,60:PRINT "SOUGHT"
660 FOR Z=LN TO 23:LOCATE Z:PRINT STRING$(17,32):NEXT Z
670 '
680 '.....input data
690 FOR Z=1 TO N:IF FLAG(Z)=1 THEN 770
700 IF I(Z)<>0 THEN 770
710 IF K=6 THEN IF Z>=9 AND Z<=N THEN 770
720 IF K=9 THEN IF Z>=6 AND Z<=9 THEN 770
730 COLOR 14
740 LOCATE LN-1:PRINT " ENTER: ";I$(Z,1);;"( 0 if unknown )...(";I$(Z,2);;")";
750 INPUT I(Z):COLOR 7
760 GOSUB 800
770 NEXT Z
780 GOTO 690
790 '
800 '.....calculate
810 IF I(Z)<>0 THEN LOCATE LN-1+Z,56:PRINT USING U$;I(Z)
820 LOCATE LN-1:PRINT STRING$(80,32);:LOCATE LN-1
830 F=I(1):C=I(2):XC=I(3):L=I(4):XL=I(5):RS=I(6):ZS=I(7)
840 BS=I(8)*PI/180:RP=I(9):ZP=I(10):AP=I(11)*PI/180
850 JJ=1/(4*PI^2)*10^6    'JJ=25330.29
860 '.....scan
870 IF XL=0 AND F*L<>0 THEN XL=2*PI*F*L:GOTO 860
880 IF L=0 AND F*XL<>0 THEN L=XL/(2*PI*F):GOTO 860
890 IF F=0 AND L*XL<>0 THEN F=XL/(2*PI*L):GOTO 860
900 '
910 IF XC=0 AND F*C<>0 THEN XC=10^6/(2*PI*F*C):GOTO 860
920 IF C=0 AND F*XC<>0 THEN C=JJ/F^2:GOTO 860
930 IF F=0 AND C*XC<>0 THEN F=10^6/(2*PI*XC*C):GOTO 860
940 '
950 IF ZS=0 AND RS*XL<>0 THEN ZS=SQR(RS^2+XL^2):GOTO 860
960 IF ZS=0 AND RS*XC<>0 THEN ZS=SQR(RS^2+XC^2):GOTO 860
970 '
980 IF BS=0 AND ZS*XL*RS<>0 THEN BS=ATN(XL/RS):GOTO 860
990 IF BS=0 AND ZS*XC*RS<>0 THEN BS=-ATN(XC/RS):GOTO 860
1000 '
1010 IF ZP=0 AND RP*XL<>0 THEN ZP=RP*XL/SQR(RP^2+XL^2):GOTO 860
1020 IF ZP=0 AND RP*XC<>0 THEN ZP=RP*XC/SQR(RP^2+XC^2):GOTO 860
1030 '
1040 IF AP=0 AND ZP*XL*RP<>0 THEN AP=ATN(RP/XL):GOTO 860
1050 IF AP=0 AND ZP*XC*RP<>0 THEN AP=-ATN(RP/XC):GOTO 860
1060 '
1070 I(1)=F:I(2)=C:I(3)=XC:I(4)=L:I(5)=XL:I(6)=RS:I(7)=ZS
1080 I(8)=BS*180/PI:I(9)=RP:I(10)=ZP:I(11)=AP*180/PI
1090 IF I(Y)=0 THEN RETURN
1100 '
1110 '.....display values
1120 VIEW PRINT LN TO 24:CLS:VIEW PRINT:LOCATE LN
1130 XCC=INT(I(3)*10^4+5.000000E-01)/10^4
1140 XLL=INT(I(5)*10^4+5.000000E-01)/10^4
1150 IF I(3)<>0 THEN J$=" - j"+STR$(XCC):X=-I(3):GOTO 1180
1160 IF I(5)<>0 THEN J$=" + j"+STR$(XLL):X=I(5)
1170 '
1180 FOR Z=1 TO N
1190 PRINT TAB(2);I$(Z,1);USING U$;I(Z);
1200 'IF Z=7 OR Z=10 THEN IF I(Z)<>0 THEN Y=I(Z):PRINT J$;
1210 IF I(Z)=0 THEN PRINT ""; ELSE PRINT ;" ";I$(Z,2)
1220 IF I(Z)=0 THEN LOCATE CSRLIN-1,56:PRINT "    -    "
1230 NEXT Z
1240 PRINT TAB(20);"Admittance";STRING$(7,".");USING U$;1/Y;:PRINT " siemens"
1250 PRINT :SWAP A$,B$:COLOR 0,7
1260 PRINT " Do you want to calculate the equivalent "; A$;;" circuit?    (y/n) "
1270 COLOR 7,0
1280 Z$=INKEY$:IF Z$=""THEN 1280
1290 IF Z$="n"THEN LOCATE CSRLIN-1:PRINT STRING$(79,32):GOTO 1480
1300 IF Z$="y"THEN 1320
1310 GOTO 1280
1320 I(3)=0:I(5)=0
1330 IF A$="PARALLEL"THEN 1360
1340 IF A$="SERIES"THEN 1420
1350 '
1360 RP=(RS^2+X^2)/RS:I(9)=RP
1370 XP=(RS^2+X^2)/X
1380 IF XP<0 THEN I(3)=ABS(XP)ELSE I(5)=ABS(XP)
1390 I(6)=0:I(10)=I(7):I(7)=0:I(11)=I(8):I(8)=0
1400 GOTO 1470
1410 '
1420 RS=RP*X^2/(RP^2+X^2):I(6)=RS
1430 XS=RP^2*X/(RP^2+X^2)
1440 IF XS<0 THEN I(3)=ABS(XS)ELSE I(5)=ABS(XS)
1450 I(9)=0:I(7)=I(10):I(10)=0:I(8)=I(11):I(11)=0
1460 '
1470 GOTO 1110  'display
1480 GOTO 1780  'end
1490 '
1500 '.....diagram
1510 COLOR 0,7:T=22:LOCATE 1
1520 LOCATE ,T:PRINT "         RF CIRCUIT COMPONENTS         "
1530 LOCATE ,T:PRINT "     ÚÄÄÄ¿                   ÚÄÄÄ¿     "
1540 LOCATE ,T:PRINT "  ÚÄÄ´ X ÃÄ\/\/\Ä¿    ÚÄÄÂÄÄÄ´ X ÃÄÄÄ¿ "
1550 LOCATE ,T:PRINT " ÄÙ  ÀÄÄÄÙ   R   ³   ÄÙ  ³   ÀÄÄÄÙ   ³ "
1560 LOCATE ,T:PRINT " Eac             ³   Eac ÀÄÄÄ\/\/\ÄÄÄ´ "
1570 LOCATE ,T:PRINT " Ä¿              ³   Ä¿        R     ³ "
1580 LOCATE ,T:PRINT "  ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ    ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ "
1590 LOCATE ,T:PRINT "   SERIES CIRCUIT     PARALLEL CIRCUIT "
1600 COLOR 7,0:RETURN
1610 '
1620 '.....prologue
1630 T=7
1640 PRINT TAB(T);
1650 PRINT "There are many interactive components in RF circuits. One common to"
1660 PRINT TAB(T);
1670 PRINT "most equations is the sum of all resistances associated with energy"
1680 PRINT TAB(T);
1690 PRINT "losses in the circuit, e.g., in capacitors, inductors, wire"
1700 PRINT TAB(T);
1710 PRINT "resistance, core losses and skin effect. Once this total resistance"
1720 PRINT TAB(T);
1730 PRINT "is known, values of other circuit factors shown in the list below"
1740 PRINT TAB(T);
1750 PRINT "can be computed quickly with this program."
1760 RETURN
1770 '
1780 '.....end
1790 GOSUB 1820:CLS:GOTO 180
1800 END
1810 '
1820 'PRT
1830 KEY OFF:GOSUB 1900:LOCATE 25,5:COLOR 0,2
1840 PRINT " Send this page to:(1)Printer Queue? (2)Printout? ";
1850 PRINT "(3)Next page? (1/2/3)";:COLOR 7,0
1860 Z$=INKEY$:IF Z$<"1"OR Z$>"3"THEN 1860 ELSE GOSUB 1900
1870 IF Z$="3"THEN RETURN
1880 FOR I%=1 TO 24:FOR J%=1 TO 80:LPRINT CHR$(SCREEN(I%,J%));:NEXT J%:NEXT I%
1890 IF Z$="2"THEN LPRINT CHR$(12) ELSE 1830
1900 LOCATE 25,1:PRINT STRING$(80,32);:RETURN
