[NET] ' From RF Design Magazine  Revised 1989-2005  Bill Yotter
MAINWIN 90 40:PI=asn(1)*2:ON ERROR GOTO [OUCH]
CLS:GOSUB [MENU]
PRINT TAB(20);:INPUT "# of Nodes {0 quits} ? ";Y
IF Y = 0 THEN END
DIM A(Y, Y), B(Y, Y), P(Y, Y), Q(Y, Y), B1(Y, Y), Q1(Y, Y)
LGTEN = 20 / LOG(10)
[ElementInput]
PRINT:PRINT TAB(25);:INPUT "Element     ? "; Z$
IF INSTR("Rr",LEFT$(Z$,1)) THEN [RES]
IF INSTR("Cc",LEFT$(Z$,1)) THEN [CAP]
IF INSTR("Ll",LEFT$(Z$,1)) THEN [IND]
IF INSTR("Aa",LEFT$(Z$,1)) THEN [AMP]
IF INSTR("Ff",LEFT$(Z$,1)) THEN [FET]
IF INSTR("Qq",LEFT$(Z$,1)) THEN [TRAN]
IF INSTR("Ee",LEFT$(Z$,1)) THEN [CIOR]
PRINT TAB(25);"input error":GOTO [ElementInput]
[RES]
PRINT TAB(25);:INPUT "Node from   ? ";I
PRINT TAB(25);:INPUT "Node to     ? ";J
PRINT TAB(25);:INPUT "Ohms        ? ";V
IF I<0 OR I>Y OR J<0 OR J>Y OR V<1 THEN PRINT TAB(25);"error - redo element":goto [ElementInput]
V = 1 / V: GOSUB [FEMA]: GOTO [ElementInput]
[CAP]
PRINT TAB(25);:INPUT "Node from   ? ";I
PRINT TAB(25);:INPUT "Node to     ? ";J
PRINT TAB(25);:INPUT "Cap         ? ";V
IF I<0 OR I>Y OR J<0 OR J>Y OR V=0 THEN PRINT TAB(25);"error - redo element":goto [ElementInput]
GOSUB [FEMC]: GOTO [ElementInput]
[IND]
PRINT TAB(25);:INPUT "Node from   ? ";I
PRINT TAB(25);:INPUT "Node to     ? ";J
PRINT TAB(25);:INPUT "Ind         ? ";V
IF I<0 OR I>Y OR J<0 OR J>Y OR V=0 THEN PRINT TAB(25);"error - redo element":goto [ElementInput]
V = -1 / V: GOSUB [FEME]: GOTO [ElementInput]
[FET]
PRINT TAB(25);:INPUT "Node G      ? ";K
PRINT TAB(25);:INPUT "Node S      ? ";J
PRINT TAB(25);:INPUT "Node D      ? ";I
PRINT TAB(25);:INPUT "A/V         ? ";V
IF I<0 OR I>Y OR J<0 OR J>Y OR V<1 OR K<0 OR K>Y THEN PRINT TAB(25);"error - redo element":goto [ElementInput]
L = J: GOTO [EIB]
[TRAN]
PRINT TAB(25);:INPUT "Node B      ? ";K
PRINT TAB(25);:INPUT "Node E      ? ";J
PRINT TAB(25);:INPUT "Node C      ? ";I
PRINT TAB(25);:INPUT "Beta        ? ";B1
PRINT TAB(25);:INPUT "B|E Ohms    ? ";V
IF I<0 OR I>Y OR J<0 OR J>Y OR V<1 OR K<0 OR K>Y OR B1<1 THEN PRINT TAB(25);"error - redo element":goto [ElementInput]
L = I: I = K: V = 1 / V: GOSUB [FEMA]
I = L: L = J: GOTO [EIA]
[AMP]
PRINT TAB(25);:INPUT "Node +In    ? ";K
PRINT TAB(25);:INPUT "Node -In    ? ";L
PRINT TAB(25);:INPUT "Node +Out   ? ";J
PRINT TAB(25);:INPUT "Node -Out   ? ";I
PRINT TAB(25);:INPUT "OLG         ? ";B1
PRINT TAB(25);:INPUT "Zo          ? ";V
IF I<0 OR I>Y OR J<0 OR J>Y OR V<1 OR K<0 OR K>Y OR B1<1 OR L<0 OR L>Y THEN PRINT TAB(25);"error - redo element":goto [ElementInput]
V = 1 / V: GOSUB [FEMA]
[EIA]
V = B1 * V
[EIB]
GOSUB [FEMG]: GOTO [ElementInput]
[CIOR] ' compute i/o ratios
PRINT:PRINT TAB(25);:INPUT "Input Node  ? ";E
PRINT TAB(25);:INPUT "Output Node ? ";F
IF E<1 OR E>Y OR F<1 OR F>Y OR E=F THEN PRINT TAB(25);"error - redo entrees":goto [CIOR]
FOR I = 0 TO N: FOR J = 0 TO N
P(I, J) = A(I, J): Q1(I, J) = B1(I, J)
Q(I, J) = B(I, J): NEXT J: NEXT I
GOTO [CIORC]
[CIORA]
PR = 1:ND = 1:QR = 0
[CIORB]
PRINT:PRINT TAB(25);:INPUT "Input Node  ? ";E
PRINT TAB(25);:INPUT "Output Node ? ";F
[CIORC]
PRINT TAB(25);:INPUT "Start Freq  ? ";G
PRINT TAB(25);:INPUT "End   Freq  ? ";H
PRINT TAB(25);:INPUT "# of Steps  ? ";D
IF E<1 OR E>Y OR F<1 OR F>Y OR G<1 OR H<(G+1) OR D<1 OR D>100 OR E=F THEN PRINT TAB(25);"error - redo entrees":goto [CIORB]
IF D > 0 THEN D = (H - G) / D
IF QR = 0 AND PR THEN GOSUB [PlotTitle]
IF D < 0 THEN F2 = (D-(2*D)) ELSE F2 = 1 + (H - G) / D
IF D < 0 THEN D = (((H / G) ^ (1 / ((D-(2*D)) - 1)))-(2*((H / G) ^ (1 / ((D-(2*D)) - 1)))))
F1 = G: FOR I1 = 1 TO F2
I2 = 0: IF ND OR QR THEN [CIORD]
FOR I2 = 0 TO 1
[CIORD]
W = 2 * PI * F1: D1 = E: D2 = F: GOSUB [CDH]
V = B1: U = D2
IF (-1) ^ (E + F) > 0 THEN [CIORE]
U = U - 180
[CIORE]
D1 = E: D2 = E: GOSUB [CDH]
IF V = 0 OR B1 = 0 THEN [CIORF]
V = V / B1: DB = LGTEN * LOG(V)
[CIORF]
U = U - D2: IF U > 180 THEN U = U - 360
IF U < -180 THEN U = U + 360
IF QR THEN [CIORG]
IF PR AND I2 = 0 THEN GOSUB [PlotData]
[CIORG]
DU = U1 - U: U1 = U: IF ND THEN [CIORH]
F1 = F1 * (1 + .00001): NEXT I2
U2 = DU / U3 / 360 * 100000
[CIORH]
IF PR THEN PRINT
IF D < 0 THEN F1 = (U3-(2*U)) * D ELSE F1 = U3 + D
NEXT I1
PRINT:PRINT TAB(7);:INPUT "Re-sweep same network with new nodes or frequencies  y/n ? "; Z$
IF INSTR("Nn",LEFT$(Z$,1)) THEN [INIT] ELSE [CIORA]
[FEMA] ' form element matrices
IF I = 0 THEN [FEMB]
A(I, I) = A(I, I) + V
IF J = 0 THEN [FEMH]
A(I, J) = A(I, J) - V: A(J, I) = A(J, I) - V
[FEMB]
A(J, J) = A(J, J) + V
[FEMH] IF I > N THEN N = I
IF J > N THEN N = J
RETURN
[FEMC]
IF I = 0 THEN [FEMD]
B(I, I) = B(I, I) + V
IF J = 0 THEN [FEMH]
B(I, J) = B(I, J) - V: B(J, I) = B(J, I) - V
[FEMD]
B(J, J) = B(J, J) + V
GOTO [FEMH]
[FEME]
IF I = 0 THEN [FEMF]
B1(I, I) = B1(I, I) + V
IF J = 0 THEN [FEMH]
B1(I, J) = B1(I, J) - V: B1(J, I) = B1(J, I) - V
[FEMF]
B1(J, J) = B1(J, J) + V
GOTO [FEMH]
[FEMG]
IF I <> 0 AND K <> 0 THEN A(I, K) = A(I, K) + V
IF J <> 0 AND L <> 0 THEN A(J, L) = A(J, L) + V
IF J <> 0 AND K <> 0 THEN A(J, K) = A(J, K) - V
IF I <> 0 AND L <> 0 THEN A(I, L) = A(I, L) - V
IF K > N THEN N = K
IF L > N THEN N = L
GOTO [FEMH]
[CDA] ' compute determinantes
IF N > 1 THEN [CDB]
D1 = A(N, N): D2 = B(N, N): RETURN
[CDB]
D1 = 1: D2 = 0: K = 1
[CDC]
L = K
S = ABS(A(K, K)) + ABS(B(K, K))
FOR I = K TO N
T = ABS(A(I, K)) + ABS(B(I, K))
IF S >= T THEN [CDD]
L = I: S = T
[CDD]
NEXT I
IF L = K THEN [CDE]
FOR J = 1 TO N
S = (A(K, J)-(2*A(K, J)))
A(K, J) = A(L, J)
A(L, J) = S
S1 = (B(K, J)-(2*B(K, J)))
B(K, J) = B(L, J): B(L, J) = S1
NEXT J
[CDE]
L = K + 1
FOR I = L TO N
S1 = A(K, K) * A(K, K) + B(K, K) * B(K, K)
S = (A(I, K) * A(K, K) + B(I, K) * B(K, K)) / S1
B(I, K) = (A(K, K) * B(I, K) - A(I, K) * B(K, K)) / S1
A(I, K) = S: NEXT I
J2 = K - 1
IF J2 = 0 THEN [CDF]
FOR J = L TO N
FOR I = 1 TO J2
A(K, J) = A(K, J) - A(K, I) * A(I, J) + B(K, I) * B(I, J)
B(K, J) = B(K, J) - B(K, I) * A(I, J) - A(K, I) * B(I, J)
NEXT I: NEXT J
[CDF]
J2 = K: K = K + 1
FOR I = K TO N
FOR J = 1 TO J2
A(I, K) = A(I, K) - A(I, J) * A(J, K) + B(I, J) * B(J, K)
B(I, K) = B(I, K) - B(I, J) * A(J, K) - A(I, J) * B(J, K)
NEXT J: NEXT I
IF K <> N THEN [CDC]
L = 1
J2 = INT(N / 2)
IF N = 2 * J2 THEN [CDG]
L = 0
D1 = A(N, N)
D2 = B(N, N)
[CDG]
FOR I = 1 TO J2
J = N - I + L
S = A(I, I) * A(J, J) - B(I, I) * B(J, J)
S1 = A(I, I) * B(J, J) + A(J, J) * B(I, I)
T = D1 * S - D2 * S1
D2 = D2 * S + D1 * S1
D1 = T
NEXT I
RETURN
[CDH]
N1 = N: N = N - 1: I = 0
FOR K = 1 TO N
IF K <> D1 THEN [CDI]
I = 1
[CDI]
J = 0
FOR L = 1 TO N
IF L <> D2 THEN [CDJ]
J = 1
[CDJ]
A(K, L) = P(K + I, L + J)
B(K, L) = W * Q(K + I, L + J) + Q1(K + I, L + J) / W
NEXT L: NEXT K
GOSUB [CDA]
N = N1
B1 = SQR(D1 * D1 + D2 * D2)
IF B1 + D1 = 0 THEN [CDK]
IF D1 = 0 AND D2 = 0 THEN [CDL]
IF D1 < 0 AND D2 = 0 THEN [CDK]
D2 = 360 / PI * ATN(D2 / (B1 + D1)): RETURN
[CDK]
D2 = 180
[CDL]
RETURN
[MENU]
PRINT:PRINT TAB(13);"--=*<  The Network Element Format  >*=--":PRINT
PRINT TAB(7);"E      (exit)       Exit -- element entry section"
PRINT TAB(7);"C      (capacitor)  From node #, To node #, Value"
PRINT TAB(7);"L      (inductor)   From node #, To node #, Value"
PRINT TAB(7);"R      (resistor)   From node #, To node #, Value"
PRINT TAB(7);"A      (op-amp)     +In, -In, +Out, -Out, OLG, Zo"
PRINT TAB(7);"F      (fet)        Gate, Source, Drain, Gain /Av"
PRINT TAB(7);"Q      (npn/pnp)    Base, Emitter, Collector, Beta, BE Ohms"
PRINT:PRINT:ND=1:QR=0:PR=1:RETURN
[PlotTitle]
PRINT:PRINT"         Freq        dB      Phase      Right side = 0db     +db values reflected as o"
PRINT"    =========    ======    =======   50========40========30========20========10========0":RETURN
[PlotData]
U3 = F1
PRINT USING("##########.##", F1);"   ";
PRINT USING("####.##", DB);"     ";
PRINT USING("####.#", U);
IF DB>0 THEN XXX$="o" ELSE XXX$="*"
DBX=ABS(DB):IF DBX>89 THEN DBX=89
DBX=89-DBX:PRINT TAB(DBX);XXX$;:RETURN
[OUCH]
PRINT:PRINT TAB(8);"The network has reported data out of bounds, check your elements and nodes."
PRINT:PRINT TAB(10);"Copy and paste any information you want to keep into your text editor."
PRINT:PRINT TAB(12);"When your ready to clear the program and start over press any key. ";:X$=INPUT$
[INIT]
DIM A(Y, Y), B(Y, Y), P(Y, Y), Q(Y, Y), B1(Y, Y), Q1(Y, Y)
B1=0:D=0:D1=0:D2=0:DB=0:DBX=0:DU=0:D=0:E=0:F=0:F1=0:F2=0:G=0
H=0:I=0:I1=0:I2=0:J=0:J2=0:K=0:L=0:LGTEN=0:N=0:N1=0:ND=0:PI=0
PR=0:QR=0:S=0:S$="":S1=0:T=0:U=0:U1=0:U2=0:U3=0:V=0:W=0:X$=""
XXX$="":Y=0:Z=0:Z$="":GOTO [NET]