home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1
/
HamRadio.cdr
/
tech
/
eepub15
/
nodnet.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-07-22
|
60KB
|
1,379 lines
{ Written for Apple II Mar 83... by Charles J Dockstader
Modified many times
Nodal equations see EDN Sept 1 1982
Transmission line equations see RF DESIGN EXPO 86
Converted to GWBasic Oct 86 by CJD
Converted to Pascal Dec 86... by CJD}
program NODNET;
const TDN = '6 53 PM July 22 1987 Charles J Dockstader';
NoN = 25; {Max No of Nodes}
NoC = 40; {Max No of Components}
type NNKbdRecord = RECORD
Parts : string[4];
Value1, Value2 : real;
Nodes1, Nodes2, Nodes3, Nodes4 : integer;
end;
String80 = string[80];
var KbdRecord : NNKbdRecord;
Infile, Outfile : File of NNKbdRecord;
Compo : array[1..NoC] of string[4];
Nodes : array[1..4] of array[1..NoC] of integer;
Value : array[1..2] of array[1..NoC] of real;
Last : array[1..5] of array[1..300] of real;
Ref : array[1..5] of array[1..300] of real;
A : array[1..NoN] of array[1..NoN] of real;
B : array[1..NoN] of array[1..NoN] of real;
B1 : array[1..NoN] of array[1..NoN] of real;
P : array[1..NoN] of array[1..NoN] of real;
Q : array[1..NoN] of array[1..NoN] of real;
Q1 : array[1..NoN] of array[1..NoN] of real;
S : array[1..NoN] of array[1..NoN] of real;
B2, C7, D1, D2, F, F1, F2, F7, FL, FT, GA, G2, G3, G4, G5, G6, G7,
G8, L7, LA, LM, LR, LT, LX, ML, MM, Q2, R7, RR, S1, S2, T, T1,
T2, TH, TL, TT, V, W, X, Y, GRET, LRET, THRET, VRET, TempR: real;
D, F3, F4, FLG, I, J, J2, K, L, LF, M, N, N1, NC, ND,
NI, NN, NO, Nod, Nx, PL, QL, RL, R1, R2, X1, Y0,
Y1, Y2, Y3, Y4, Y5, Y6, Err, TempI: integer;
FLGA, FLGB, FLGC, FLGL : boolean;
Ch, Chm : char;
PS, TM, RLOS : string[1];
Ch1 : string[2];
F7S, R7S, C7S, L7S, Comp: string[4];
CirName: string[8];
TempS : string[10];
CircuitName : string[14];
procedure Beep;
begin Sound(440); Delay(150); NoSound end;
procedure Zero;
begin draw(I-1,J,I+1,J,1); draw(I+2,J+1,I+2,J+5,1);
draw(I+1,J+6,I-1,J+6,1); draw(I-2,J+5,I-2,J+1,1) end;
procedure One;
begin plot(I-1,J+1,1); draw(I,J,I,J+5,1); draw(I-1,J+6,I+1,J+6,1) end;
procedure Two;
begin plot(I-2,J+1,1); draw(I-1,J,I+1,J,1); draw(I+2,J+1,I-2,J+5,1);
draw(I-2,J+6,I+2,J+6,1) end;
procedure Three;
begin plot(I-2,J+1,1);draw(I-1,J,I+1,J,1);draw(I+2,J+1,I+2,J+2,1);plot(I+1,J
+3,1);draw(I+2,J+4,I+2,J+5,1);draw(I+1,J+6,I-1,J+6,1);plot(I-2,J+5,1) end;
procedure Four;
begin draw(I+1,J,I+1,J+6,1); draw(I-2,J+4,I+2,J+4,1);
draw(I-2,J+3,I+1,J,1) end;
procedure Five;
begin draw(I+2,J,I-2,J,1); draw(I-2,J,I-1,J+2,1); draw(I-2,J+2,I+1,J+2,1);
draw(I+2,J+3,I+2,J+5,1); draw(I+1,J+6,I-1,J+6,1); plot(I-2,J+5,1) end;
procedure Six;
begin draw(I+1,J,I-1,J,1); draw(I-2,J+1,I-2,J+5,1); draw(I-1,J+6,I+1,J+6,1);
draw(I+2,J+5,I+2,J+4,1); draw(I+1,J+3,I-1,J+3,1) end;
procedure Seven;
begin draw(I-2,J,I+2,J,1); draw(I+2,J+1,I-2,J+5,1); plot(I-2,J+6,1) end;
procedure Eight;
begin draw(I-1,J,I+1,J,1); draw(I+2,J+1,I+2,J+2,1); draw(I+2,J+4,I+2,J+5,1);
draw(I+1,J+6,I-1,J+6,1); draw(I-2,J+5,I-2,J+4,1); draw(I-2,J+2,I-2,J+1,1);
draw(I-1,J+3,I+1,J+3,1) end;
procedure Nine;
begin draw(I-1,J,I+1,J,1); draw(I+2,J+1,I+2,J+5,1); draw(I+1,J+6,I-1,J+6,1);
draw(I+1,J+3,I-1,J+3,1); draw(I-2,J+2,I-2,J+1,1) end;
procedure Decpt;
begin draw(I-5,J+5,I-4,J+5,1); draw(I-5,J+6,I-4,J+6,1); end;
procedure KKK;
begin draw(I-2,J,I-2,J+6,1); draw(I+2,J,I-1,J+3,1); draw(I+2,J+6,I-1,J+3,1)
end;
procedure MMM;
begin draw(I-2,J,I-2,J+6,1); draw(I+2,J,I+2,J+6,1); plot(I-1,J+1,1);
plot(I+1,J+1,1); Draw(I,J+2,I,J+3,1) end;
procedure GGG;
begin plot(I+2,J+1,1); draw(I+1,J,I-1,J,1); draw(I-2,J+1,I-2,J+5,1); draw
(I-1,J+6,I+2,J+6,1); draw(I+2,J+6,I+2,J+5,1);draw(I+2,J+4,I,J+4,1) end;
procedure FreqLabel;
begin
draw(137,179,134,179,1);draw(133,179,133,185,1);draw(136,182,134,182,1);
draw(139,185,139,180,1);draw(139,179,142,179,1);draw(143,180,143,181,1);
draw(140,182,142,182,1);draw(143,185,142,183,1);draw(149,179,146,179,1);
draw(145,179,145,184,1);draw(145,185,149,185,1);draw(146,182,148,182,1);
draw(154,179,152,179,1);draw(151,180,151,184,1);draw(152,185,154,185,1);
draw(155,180,155,186,1);draw(153,183,154,184,1);draw(157,179,157,184,1);
draw(158,185,160,185,1);draw(161,179,161,184,1);draw(167,179,164,179,1);
draw(163,179,163,184,1);draw(163,185,167,185,1);draw(166,182,164,182,1);
draw(169,179,169,185,1);draw(170,181,172,183,1);draw(173,179,173,185,1);
draw(178,179,176,179,1);draw(175,180,175,184,1);draw(176,185,178,185,1);
draw(181,179,181,180,1);draw(183,182,183,185,1);draw(185,179,185,180,1);
plot(179,180,1);plot(179,184,1);plot(182,181,1);plot(184,181,1)
end;
procedure GainLabel;
begin for I := 15 to 23 do draw(I,74,I,126,0);
draw(17,77,21,77,2);draw(19,75,19,79,2);draw(17,81,18,81,2);
draw(20,81,21,81,2);draw(16,82,16,85,2);draw(19,82,19,85,2);
draw(22,82,22,85,2);draw(16,85,22,85,2);draw(17,87,21,87,2);
draw(16,88,16,91,2);draw(22,88,22,91,2);draw(16,91,22,91,2);
draw(19,93,19,97,2);draw(16,105,22,105,2);draw(16,109,22,109,2);
draw(18,108,20,106,2);draw(16,112,21,112,2);draw(16,111,16,113,2);
draw(22,111,22,113,2);draw(16,117,17,116,2);draw(18,115,22,115,2);
draw(20,116,20,118,2);draw(18,119,22,119,2);plot(17,118,2);
draw(16,122,16,124,2);draw(17,125,21,125,2);draw(22,121,22,124,2);
draw(20,121,20,122,2);plot(21,121,2);plot(17,121,2)
end;
procedure PhaseLabel;
begin Y := 22.222;
repeat draw(283,round(Y),295,round(Y),1); Y := Y + 22.222 until Y > 190;
I:=314;J:=19;Zero; I:=308;J:=41;Four; I:=314;Five; I:=308;J:=63;Nine;
I:=314;Zero; I:=303;J:=86;One; I:=308;Three; I:=314;Five;
I:=303;J:=108;One; I:=308;Eight; I:=314;Zero; I:=302;J:=130;Two;
I:=308;Two; I:=314;Five; I:=302;J:=152;Two; I:=308;Seven;
I:=314;Zero; I:=302;J:=175;Three; I:=308;One; I:=314;Five;
for I := 291 to 299 do draw(I,67,I,125,0); {Clr Screen}
draw(292,68,298,68,1);draw(295,69,295,71,1);draw(296,72,297,72,1);
draw(298,69,298,71,1);draw(292,74,298,74,1);draw(292,78,298,78,1);
draw(295,75,295,77,1);draw(292,80,296,80,1);draw(297,81,298,82,1);
draw(294,81,294,83,1);draw(292,84,296,84,1);plot(297,83,1);
draw(292,87,292,89,1);draw(293,90,294,90,1);draw(295,87,295,89,1);
draw(296,86,297,86,1);draw(298,87,298,89,1);plot(293,86,1);
plot(297,90,1);draw(292,96,292,93,1);draw(292,92,297,92,1);
draw(298,92,298,96,1);draw(295,93,295,95,1);draw(292,101,297,101,1);
draw(298,101,298,104,1);draw(297,105,293,105,1);draw(292,102,292,104,1);
draw(298,110,298,108,1);draw(298,107,293,107,1);draw(292,107,292,110,1);
draw(295,108,295,109,1);draw(293,112,297,112,1);draw(298,113,298,115,1);
draw(292,113,292,115,1);draw(292,116,294,116,1);plot(294,115,1);
plot(297,116,1);draw(295,118,295,122,1);
end;
procedure TimeLabel;
begin Y := 50;
repeat draw(283,round(Y),295,round(Y),3); Y := Y + 50 until Y > 190;
Y := 24;
repeat draw(283,round(Y),295,round(Y),3); Y := Y + 50 until Y > 190;
for I := 301 to 318 do draw(I,20,I,160,0);
I:=314;J:=21;Zero;Decpt;I:=305;Three;I:=314;J:=47;Zero;Decpt;
I:=306;One;I:=314;J:=71;Three;Decpt;I:=305;Zero;I:=314;J:=97;One;
Decpt;I:=305;Zero;I:=314;J:=121;Three;I:=308;Zero;Decpt;
I:=314;J:=147;One;I:=308;Zero;Decpt;I:=314;J:=171;Three;
I:=308;Zero;I:=302;Zero;Decpt;
for I := 292 to 300 do draw(I,56,I,142,0);
draw(299,57,299,61,3);draw(293,59,298,59,3);draw(293,63,293,65,3);
draw(294,64,298,64,3);draw(299,63,299,65,3);draw(293,67,299,67,3);
plot(298,68,3);draw(296,69,297,69,3);plot(298,70,3);
draw(293,71,299,71,3);draw(293,73,299,73,3);draw(293,74,293,77,3);
draw(296,74,296,76,3);draw(299,74,299,77,3);draw(293,84,299,84,3);
draw(293,85,293,87,3);draw(299,85,299,87,3);draw(294,88,298,88,3);
draw(293,90,299,90,3);draw(293,91,293,94,3);draw(296,91,296,93,3);
draw(299,91,299,94,3);draw(293,96,299,96,3);draw(293,97,293,100,3);
draw(293,102,297,102,3);plot(298,103,3);plot(299,104,3);
plot(298,105,3);draw(293,106,297,106,3);draw(295,103,295,105,3);
draw(293,110,296,110,3);draw(297,110,299,108,3);draw(297,110,299,112,3);
draw(294,119,297,119,3);draw(293,120,293,122,3);draw(294,123,297,123,3);
plot(294,125,3);draw(293,126,293,128,3);draw(294,129,295,129,3);
draw(296,126,296,128,3);draw(297,125,298,125,3);draw(299,126,299,128,3);
plot(298,129,3);draw(293,131,299,131,3);draw(293,132,293,135,3);
draw(296,132,296,134,3);draw(299,132,299,135,3);plot(294,141,3);
draw(293,138,293,140,3);draw(294,137,298,137,3);draw(299,138,299,140,3);
plot(298,141,3);
end;
procedure RetLossLabel;
begin Y := 22.222;
repeat draw(283,round(Y),295,round(Y),1); Y := Y + 22.222 until Y > 190;
I:=314;J:=19;Zero; I:=314;J:=41;Five; I:=309;J:=63;One; I:=314;Zero;
I:=309;J:=86;One; I:=314;Five; I:=308;J:=108;Two; I:=314;Zero;
I:=308;J:=130;Two; I:=314;Five; I:=308;J:=152;Three; I:=314;Zero;
I:=308;J:=175;Three; I:=314;Five;
for I := 291 to 299 do draw(I,67,I,140,0); {Clr Screen}
draw(292,61,298,61,3);draw(295,62,295,64,3);draw(294,63,292,65,3);
draw(296,65,297,65,3);draw(298,62,298,64,3);draw(292,67,298,67,3);
draw(292,68,292,71,3);draw(295,68,295,70,3);draw(298,68,298,71,3);
draw(298,73,298,77,3);draw(292,75,297,75,3);draw(293,79,298,79,3);
draw(292,80,292,82,3);draw(293,83,298,83,3);draw(292,85,298,85,3);
draw(295,86,295,88,3);draw(294,87,292,89,3);draw(296,89,297,89,3);
draw(298,86,298,88,3);draw(292,91,298,91,3);draw(298,91,292,95,3);
draw(292,95,298,95,3);draw(292,101,298,101,3);draw(292,102,292,105,3);
draw(293,107,297,107,3);draw(292,108,292,110,3);draw(298,108,298,110,3);
draw(293,111,297,111,3);draw(296,113,297,113,3);draw(298,114,298,116,3);
plot(297,117,3);draw(295,114,295,116,3);draw(293,117,294,117,3);
draw(292,114,292,116,3);plot(293,113,3);draw(296,119,297,119,3);
draw(298,120,298,122,3);plot(297,123,3);draw(295,120,295,122,3);
draw(293,123,294,123,3);draw(292,120,292,122,3);draw(292,129,298,129,3);
draw(292,130,292,132,3);draw(293,133,297,133,3);draw(298,130,298,132,3);
draw(292,135,298,135,3);draw(292,136,292,138,3);draw(293,139,294,139,3);
draw(295,136,295,138,3);draw(296,139,297,139,3);draw(298,136,298,138,3);
end;
procedure Numbers;
begin if K = 0 then Zero; if K = 1 then One; if K = 2 then Two;
if K = 3 then Three; if K = 4 then Four; if K = 5 then Five;
if K = 6 then Six; if K = 7 then Seven; if K = 8 then Eight;
if K = 9 then Nine
end;
procedure RealsForm;
begin if (TempR >= 1000) then str(TempR:4:0,TempS);
if (TempR < 1000) and (TempR >= 100) then str(TempR:4:1,TempS);
if (TempR < 100) and (TempR >= 10) then str(TempR:4:2,TempS);
if (TempR < 10) and (TempR >= 1) then str(TempR:4:3,TempS);
if (TempR < 1) and (TempR >= 0.1) then str(TempR:4:4,TempS);
if (TempR < 0.1) and (TempR >= 0.01) then str(TempR:4:5,TempS);
if (TempR < 0.01) and (TempR >= 0.001) then str(TempR:4:6,TempS);
if (TempR < 0.001) and (TempR >= 0.0001) then str(TempR:4:7,TempS);
if (TempR < 0.0001) and (TempR >= 0.00001) then str(TempR:4:8,TempS);
if (TempR < 0.00001) then str(TempR:4:9,TempS)
end;
procedure Units;
begin F7:=1E6; F7S:='MHz'; R7:=1; R7S:='ohm ';
C7:=1E-12; C7S:='pf '; L7:=1E-6; L7S:='uh '
end;
procedure UnitsAre;
begin writeln(' Units are: ',F7S,' ',R7S,' ',C7S,' ',L7S)
end;
procedure Node;
begin repeat gotoXY(Nx,whereY); write(Nodes[Nod,NC],' ');
gotoXY(Nx,whereY); read(Ch1); val(Ch1,TempI,Err);
if TempI > ND then Beep until TempI <= ND;
if Ch1 <> '' then Nodes[Nod,NC] := TempI;
gotoXY(Nx,whereY); write(Nodes[Nod,NC],' ')
end;
procedure Resistor;
begin Compo[NC] := 'R'; Comp := 'Res';
gotoXY(5,whereY); write(Comp); ClrEol;
TempR := Value[1,NC]/R7; RealsForm;
gotoXY(10,whereY); write(TempS,' ',R7S,' ');
repeat gotoXY(10,whereY); read(TempS); val(TempS,TempR,Err);
if TempS <> '' then Value[1,NC] := TempR * R7;
TempR := Value[1,NC]/R7;
until TempR <> 0.0; RealsForm;
gotoXY(10,whereY); write(TempS,' ',R7S,' ');
repeat
Nx := 40; Nod := 1; Node; Nx := 48; Nod := 2; Node;
if Nodes[1,NC] = Nodes[2,NC] then Beep
until Nodes[1,NC] <> Nodes[2,NC]
end;
procedure Capacitor;
begin Compo[NC] := 'C'; Comp := 'Cap';
gotoXY(5,whereY); write(Comp); ClrEol;
TempR := Value[1,NC]/C7; RealsForm;
gotoXY(10,whereY); write(TempS,' ',C7S,' ');
repeat gotoXY(10,whereY); read(TempS); val(TempS,TempR,Err);
if TempS <> '' then Value[1,NC] := TempR * C7;
TempR := Value[1,NC]/C7;
until TempR <> 0.0; RealsForm;
gotoXY(10,whereY); write(TempS,' ',C7S,' ');
repeat
Nx := 40; Nod := 1; Node; Nx := 48; Nod := 2; Node;
if Nodes[1,NC] = Nodes[2,NC] then Beep
until Nodes[1,NC] <> Nodes[2,NC]
end;
procedure Inductor;
begin Compo[NC] := 'I'; Comp := 'Ind';
gotoXY(5,whereY); write(Comp); ClrEol;
TempR := Value[1,NC]/L7; RealsForm;
gotoXY(10,whereY); write(TempS,' ',L7S,' ');
repeat gotoXY(10,whereY); read(TempS); val(TempS,TempR,Err);
if TempS <> '' then Value[1,NC] := TempR * L7;
TempR := Value[1,NC]/L7;
until TempR <> 0.0; RealsForm;
gotoXY(10,whereY); write(TempS,' ',L7S,' ');
repeat
Nx := 40; Nod := 1; Node; Nx := 48; Nod := 2; Node;
if Nodes[1,NC] = Nodes[2,NC] then Beep
until Nodes[1,NC] <> Nodes[2,NC]
end;
procedure OpAmp;
begin Compo[NC] := 'O'; Comp := 'OpA';
gotoXY(5,whereY); write(Comp); ClrEol;
TempR := Value[2,NC]; RealsForm;
gotoXY(10,whereY); write(TempS,' Gain(V) ');
repeat gotoXY(10,whereY); read(TempS); val(TempS,TempR,Err);
if TempS <> '' then Value[2,NC] := TempR;
TempR := Value[2,NC];
until TempR <> 0.0; RealsForm;
gotoXY(10,whereY); write(TempS,' G(V) ');
TempR := Value[1,NC]/R7; RealsForm;
gotoXY(25,whereY); write(TempS,' ',R7S,'Out ');
repeat gotoXY(25,whereY); read(TempS); val(TempS,TempR,Err);
if TempS <> '' then Value[1,NC] := TempR * R7;
TempR := Value[1,NC]/R7;
until TempR <> 0.0; RealsForm;
gotoXY(25,whereY); write(TempS,' ',R7S,'O ');
gotoXY(42,whereY); write('+In');
Nx := 40; Nod := 3; Node; write('+In ');
gotoXY(50,whereY); write('-In');
Nx := 48; Nod := 4; Node; write('-In ');
gotoXY(58,whereY); write('+Out');
Nx := 56; Nod := 2; Node; write('+Out ');
gotoXY(66,whereY); write('-Out');
Nx := 64; Nod := 1; Node; write('-Out ')
end;
procedure FET;
begin Compo[NC] := 'F'; Comp := 'FET';
gotoXY(5,whereY); write(Comp); ClrEol;
TempR := Value[1,NC]; RealsForm;
gotoXY(10,whereY); write(TempS,' Gain(A/V) ');
repeat gotoXY(10,whereY); read(TempS); val(TempS,TempR,Err);
if TempS <> '' then Value[1,NC] := TempR;
TempR := Value[1,NC];
until TempR <> 0.0; RealsForm;
gotoXY(10,whereY); write(TempS,' Gain(A/V) ');
repeat gotoXY(42,whereY); write('S');
Nx := 40; Nod := 2; Node; write('S ');
gotoXY(50,whereY); write('G');
Nx := 48; Nod := 3; Node; write('G ');
gotoXY(58,whereY); write('D');
Nx := 56; Nod := 1; Node; write('D ');
if Nodes[1,NC] = Nodes[2,NC] then Beep;
if Nodes[2,NC] = Nodes[3,NC] then Beep;
if Nodes[3,NC] = Nodes[1,NC] then Beep
until (Nodes[1,NC] <> Nodes[2,NC]) and (Nodes[2,NC] <> Nodes[3,NC]) and
(Nodes[3,NC] <> Nodes[1,NC])
end;
procedure BiPolarT;
begin Compo[NC] := 'B'; Comp := 'BPT';
gotoXY(5,whereY); write(Comp); ClrEol;
TempR := Value[2,NC]; RealsForm;
gotoXY(10,whereY); write(TempS,' Beta ');
repeat gotoXY(10,whereY); read(TempS); val(TempS,TempR,Err);
if TempS <> '' then Value[2,NC] := TempR;
TempR := Value[2,NC];
until TempR <> 0.0; RealsForm;
gotoXY(10,whereY); write(TempS,' B ');
TempR := Value[1,NC]/R7; RealsForm;
gotoXY(23,whereY); write(TempS,' ',R7S,'B/E ');
repeat gotoXY(23,whereY); read(TempS); val(TempS,TempR,Err);
if TempS <> '' then Value[1,NC] := TempR * R7;
TempR := Value[1,NC]/R7;
until TempR <> 0.0; RealsForm;
gotoXY(23,whereY); write(TempS,' ',R7S,'B/E ');
repeat gotoXY(42,whereY); write('E');
Nx := 40; Nod := 2; Node; write('E ');
gotoXY(50,whereY); write('B');
Nx := 48; Nod := 3; Node; write('B ');
gotoXY(58,whereY); write('C');
Nx := 56; Nod := 1; Node; write('C ');
if Nodes[1,NC] = Nodes[2,NC] then Beep;
if Nodes[2,NC] = Nodes[3,NC] then Beep;
if Nodes[3,NC] = Nodes[1,NC] then Beep
until (Nodes[1,NC] <> Nodes[2,NC]) and (Nodes[2,NC] <> Nodes[3,NC]) and
(Nodes[3,NC] <> Nodes[1,NC])
end;
procedure Line;
begin Compo[NC] := 'L'; Comp := 'Line';
gotoXY(5,whereY); write(Comp); ClrEol;
TempR := Value[2,NC]/F7; RealsForm;
gotoXY(10,whereY); write(TempS,' ',F7S,'L/4 ');
repeat gotoXY(10,whereY); read(TempS); val(TempS,TempR,Err);
if TempS <> '' then Value[2,NC] := TempR*F7;
TempR := Value[2,NC]/F7;
until TempR <> 0.0; RealsForm;
gotoXY(10,whereY); write(TempS,' ',F7S,'L/4 ');
TempR := Value[1,NC]/R7; RealsForm;
gotoXY(27,whereY); write(TempS,' ',R7S,' ');
repeat gotoXY(27,whereY); read(TempS); val(TempS,TempR,Err);
if TempS <> '' then Value[1,NC] := TempR * R7;
TempR := Value[1,NC]/R7;
until TempR <> 0.0; RealsForm;
gotoXY(27,whereY); write(TempS,' ',R7S,' ');
gotoXY(42,whereY); write('Lin');
Nx := 40; Nod := 3; Node; write('Lin ');
gotoXY(50,whereY); write('Gin');
Nx := 48; Nod := 4; Node; write('Gin ');
gotoXY(58,whereY); write('Lout');
Nx := 56; Nod := 2; Node; write('Lout ');
gotoXY(66,whereY); write('Gout');
Nx := 64; Nod := 1; Node; write('Gout ')
end;
procedure ClearData;
begin for I := 1 to NoC do
begin Compo[I] := ''; for J := 1 to 4 do begin Nodes[J,I] := 0 end;
for J := 1 to 2 do begin Value[J,I] := 0 end
end
end;
procedure ClearDeter;
begin for I := 1 to NoN do for J := 1 to NoN do
begin A[I,J] := 0.0; B[I,J] := 0.0; B1[I,J] := 0.0; P[I,J] := 0.0;
Q[I,J] := 0.0; Q1[I,J] := 0.0; S[I,J] := 0.0
end
end;
procedure Determinant;
begin N1:=N; N:=N-1; I:=0; for K := 1 to N do
begin if K = D1 then I := 1; J := 0;
for L := 1 to N do
begin if L = D2 then J := 1; A[K,L] := P[K+I,L+J];
B[K,L] := W*Q[K+I,L+J]+Q1[K+I,L+J]/W+S[K+I,L+J]
end
end;
if N <= 1 then
begin D1 := A[N,N]; D2 := B[N,N]
end
else
begin D1 := 1.0; D2 := 0.0; K := 1;
repeat L := K; S2 := abs(A[K,K]) + abs(B[K,K]);
for I := K to N do
begin T := abs(A[I,K]) + abs(B[I,K]);
if S2 < T then begin L := I; S2 := T end
end;
if L <> K then
begin for J := 1 to N do
begin S2 := -A[K,J]; A[K,J] := A[L,J]; A[L,J] := S2;
S1 := -B[K,J]; B[K,J] := B[L,J]; B[L,J] := S1
end
end;
L := K + 1; for I := L to N do
begin S1 := A[K,K] * A[K,K] + B[K,K] * B[K,K];
S2 := (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] := S2
end;
J2 := K - 1; if J2 <> 0 then
begin for J := L to N do
begin for I := 1 to J2 do
begin 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]
end
end
end;
J2 := K; K := K + 1; for I := K to N do
begin for J := 1 to J2 do
begin 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]
end
end
until K = N;
L := 1; J2 := trunc(N/2);
if N <> 2 * J2 then begin L := 0; D1 := A[N,N]; D2 := B[N,N] end;
for I := 1 to J2 do
begin J := N - I + L; S2 := 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 * S2 - D2 * S1;
D2 := D2 * S2 + D1 * S1; D1 := T
end;
N := N1; if ((D1<1E-16) and (D1> -1E-16)) or ((D2<1E-16) and
(D2> -1E-16)) then B2 := sqrt(sqr(D1*1E16) + sqr(D2*1E16)) / 1E16
else B2 := sqrt(sqr(D1) + sqr(D2));
if D1 = 0.0 then
begin if D2 <> 0.0 then
begin if D2 > 0.0 then D2 := 90
else D2 := - 90
end
end
else
begin if D1 >= 0.0 then Q2 := 0.0 else Q2 := 180;
if D2 < 0.0 then Q2 := - Q2; D2 := Q2 + 180 * arctan(D2/D1)/pi
end
end
end;
procedure CheckArray;
begin if I > N then N := I; if J > N then N := J
end;
procedure LoadArrayR;
begin if I = 0 then A[J,J] := A[J,J] + V else
begin A[I,I] := A[I,I] + V; if J <> 0 then
begin A[I,J] := A[I,J] - V; A[J,I] := A[J,I] - V;
A[J,J] := A[J,J] + V
end
end;
CheckArray
end;
procedure LoadArrayC;
begin if I = 0 then B[J,J] := B[J,J] + V else
begin B[I,I] := B[I,I] + V; if J <> 0 then
begin B[I,J] := B[I,J] - V; B[J,I] := B[J,I] - V;
B[J,J] := B[J,J] + V
end
end;
CheckArray
end;
procedure LoadArrayI;
begin if I = 0 then B1[J,J] := B1[J,J] + V else
begin B1[I,I] := B1[I,I] + V; if J <> 0 then
begin B1[I,J] := B1[I,J] - V; B1[J,I] := B1[J,I] - V;
B1[J,J] := B1[J,J] + V
end
end;
CheckArray
end;
procedure LoadArrayOB;
begin 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
end;
procedure LoadArraySubLine;
begin S[QL,QL] := S[QL,QL] + RR; S[RL,RL] := S[RL,RL] + RR;
S[QL,RL] := S[QL,RL] - RR; S[RL,QL] := S[RL,QL] - RR
end;
procedure LoadArrayLine;
begin for R1 := 1 to N do
begin for R2 := 1 to N do begin S[R1,R2] := 0 end end;
for X1 := 1 to NC do
begin if Compo[X1] = 'L' then
begin RR := -1/(Value[1,X1]*sin(0.25*W/Value[2,X1])/
cos(0.25*W/Value[2,X1]));
QL := Nodes[4,X1]; RL := Nodes[3,X1]; LoadArraySubLine;
QL := Nodes[1,X1]; RL := Nodes[2,X1]; LoadArraysubLine;
RR := 1 / (Value[1,X1] * sin(0.25 * W / Value[2,X1]));
PL := Nodes[3,X1]; RL := Nodes[1,X1];
S[RL,PL] := S[RL,PL]-RR; S[PL,RL] := S[PL,RL]-RR; RL := Nodes[2,X1];
S[RL,PL] := S[RL,PL]+RR; S[PL,RL] := S[PL,RL]+RR; PL := Nodes[4,X1];
S[RL,PL] := S[RL,PL]-RR; S[PL,RL] := S[PL,RL]-RR; RL := Nodes[1,X1];
S[RL,PL] := S[RL,PL]+RR; S[PL,RL] := S[PL,RL]+RR
end
end
end;
procedure TestForLine;
begin for X1 := 1 to NC do begin if Compo[X1] = 'L' then FLGL := true end
end;
procedure LoadArray;
begin ClearDeter;
for M := 1 to NC do
begin V := Value[1,M]; B2 := Value[2,M]; I := Nodes[1,M];
J := Nodes[2,M]; K := Nodes[3,M]; L := Nodes[4,M];
if V <> 0 then
begin if Compo[M] = 'R' then begin V := 1 / V; LoadArrayR end;
if Compo[M] = 'C' then LoadArrayC;
if Compo[M] = 'I' then begin V := -1 / V; LoadArrayI end;
if Compo[M] = 'O' then begin V := 1 / V;
LoadArrayR; V := B2 * V; LoadArrayOB end;
if Compo[M] = 'F' then begin L := J; LoadArrayOB end;
if Compo[M] = 'B' then begin L := I; I := K; V := 1 / V;
LoadArrayR; I := L; L := J; V := B2 * V; LoadArrayOB end
end
end;
for I := 0 to N do for J := 0 to N do
begin P[I,J] := A[I,J]; Q1[I,J] := B1[I,J]; Q[I,J] := B[I,J] end
end;
procedure SweepStart;
begin gotoXY(5,4); writeln('The Name of Circuit is ',CirName);
gotoXY(10,6); writeln('Graph Amplitude');
gotoXY(10,7); writeln('Graph Phase ? ',PS);
gotoXY(24,7); read(kbd,Chm);
if (Chm='Y') or (Chm='y') then PS := 'Y';
if (Chm='N') or (Chm='n') then PS := 'N';
gotoXY(24,7); writeln(PS);
gotoXY(10,8); writeln('Graph Time Delay ? ',TM);
gotoXY(29,8); read(kbd,Chm);
if (Chm='Y') or (Chm='y') then TM := 'Y';
if (Chm='N') or (Chm='n') then TM := 'N';
gotoXY(29,8); writeln(TM);
gotoXY(10,9); writeln('Graph Return Loss ? ',RLOS);
gotoXY(30,9); read(kbd,Chm);
if (Chm='Y') or (Chm='y') then RLOS := 'Y';
if (Chm='N') or (Chm='n') then RLOS := 'N';
gotoXY(30,9); writeln(RLOS)
end;
procedure NoGraph;
begin Last[1,1] := 300; Ref[1,1] := 300
end;
procedure FreqLimits;
begin repeat repeat TempR := F1/F7;
gotoXY(1,10); write('Start Frequency = ',TempR:14:6,' ',F7S);
gotoXY(19,10); read(TempS); Val(TempS,TempR,Err);
if TempS <> '' then begin F1 := TempR * F7; NoGraph end;
TempR := F1/F7; gotoXY(19,10); writeln(TempR:14:6,' ',F7S,' ');
if F1 <= 0 then Beep
until F1 > 0;
repeat TempR := F2/F7;
gotoXY(1,11); write('Stop Frequency = ',TempR:14:6,' ',F7S);
gotoXY(19,11); read(TempS); Val(TempS,TempR,Err);
if TempS <> '' then begin F2 := TempR * F7; NoGraph end;
TempR := F2/F7; gotoXY(19,11); writeln(TempR:14:6,' ',F7S,' ');
if F2 <= 0 then Beep
until F2 > 0; if F1 >= F2 then Beep
until F1 < F2;
repeat gotoXY(1,12);
if FLGA then TempS := 'A' else str(F3,TempS);
write('No of Steps = ',TempS,' A for Automatic');
FLGB := false;
repeat gotoXY(19,12); read(TempS); Val(TempS,TempI,Err);
if (TempI>0) and (TempS<>'') then begin Val(TempS,F3,Err);
FLGA := false; FLGB := true end;
if (TempS = 'A') or (TempS = 'a') then begin
TempS := 'A'; F3 := 50; FLGA := true; FLGB := true end;
if (TempS='') and (FLGA) then begin TempS := 'A';
F3 := 50; FLGB := true end;
if (TempS='') and (not FLGA) then begin str(F3,TempS);
FLGB := true end;
until FLGB;
gotoXY(19,12); writeln(TempS,' ');
if F3 < 1 then Beep
until F3 > 0
end;
procedure GainLimits;
begin repeat gotoXY(1,13); write('Maximum Level = ',trunc(Y1),' dB');
gotoXY(19,13); read(TempS); Val(TempS,TempI,Err);
if TempS <>'' then begin Y1 := TempI; NoGraph end;
gotoXY(19,13); writeln(trunc(Y1),' dB ');
gotoXY(1,14); write('Minimum Level = ',trunc(Y2),' dB');
gotoXY(19,14); read(TempS); Val(TempS,TempI,Err);
if TempS <>'' then begin Y2 := TempI; NoGraph end;
gotoXY(19,14); writeln(trunc(Y2),' dB ');
if Y1 <= Y2 then Beep
until Y1 > Y2
end;
procedure TimeLimits;
begin {repeat TempR := T1;
gotoXY(1,15); write('Maximum Time = ',TempR:14:6,' uSec');
gotoXY(19,15); read(TempS); Val(TempS,TempR,Err);
if TempS <>'' then begin T1 := TempR; NoGraph end;
TempR := T1; gotoXY(19,15); writeln(TempR:14:6,' uSec ');
TempR := T2;
gotoXY(1,16); write('Minimum Time = ',TempR:14:6,' uSec');
gotoXY(19,16); read(TempS); Val(TempS,TempR,Err);
if TempS <>'' then begin T2 := TempR; NoGraph end;
TempR := T2; gotoXY(19,16); writeln(TempR:14:6,' uSec ');
if T1 <= T2 then Beep
until T1 > T2 }
end;
procedure LinearFreqGrid;
begin G6 := 0; G7 := 0; G8 := 3; if F2/F1 < 1.06 then G8 := 4;
G2 := ln((F2-F1)/3)/ln(10);
G3 := exp(int(G2)*ln(10))/2*exp(int((G2-int(G2))/0.34)*ln(2));
G4 := int(F1 / G3) * G3;
X := 319 * ((int(F1/G3)+1)*G3-F1) / (F2-F1);
repeat Y := 10;
repeat draw(round(X), trunc(Y), round(X), trunc(Y+3), 1);
Y := Y + 22.222
until Y > 172; G4 := G4 + G3;
if (X > 16) and (X < 298) then
begin if (G4>0) and (G7>0) then
begin if trunc(ln(G4)/ln(10)) > trunc(ln(G7)/ln(10)) then G6 := 1
end;
Y := 1;
repeat str(G4:0:0,TempS); val(copy(TempS,trunc(Y+G6),1),G5,Err);
I := round(X) -15 + round(Y) * 6; J := 190; K := round(G5);
Numbers; Y := Y + 1
until Y > G8; G7 := G4
end;
X := X + 319 * G3 / (F2 - F1)
until X > 319
end;
procedure LogFreqGrid;
begin G2 := 1; G4 := ln(F1) - int(ln(F1)/ln(10)) * ln(10);
L := trunc(ln(F1*1.000000001)/ln(10));
repeat G3 := 0;
repeat G3 := G3 + 1;
X := 319 * (ln(G2*G3) - G4) / ln(F2/F1); Y := 10;
repeat draw(round(X), trunc(Y), round(x), trunc(Y+3), 1);
Y := Y + 22.222
until Y > 172; if (X > 5) and (X < 315) then
begin if(F2/F1< 2000) or (G3<6) then
begin I := round(X); J := 190; K := round(G3); if K = 1 then
begin J := 187; L := L + 1; K := L;
if K = 3 then KKK; if K = 6 then MMM; if K = 9 then GGG;
if (K<>3) and (K<>6) and (K<>9) then Numbers
end
else Numbers
end
end
until G3 > 9; G2 := G2 * 10
until X > 309
end;
procedure GainGrid;
begin Y3 := 20; if Y1-Y2 <= 80 then Y3 := 10;
if Y1-Y2 <= 40 then Y3 := 5; if Y1-Y2 <= 20 then Y3 := 2;
if Y1-Y2 <= 10 then Y3 := 1; Y0 := 0;
while Y0 < -Y1 do Y0 := Y0 + Y3;
while Y0 > -Y1 do Y0 := Y0 - Y3;
Y4 := 0; while Y4 > Y1 - Y3 do Y4 := Y4 - Y3;
while Y4 < Y1 - Y3 do Y4 := Y4 + Y3; Y4 := -Y4;
Y := 200 * (Y3 + Y1 + Y0) / (Y1 - Y2);
repeat if (Y>5) and (Y<190) then
begin draw(18,round(Y),295,round(Y),1);
Y5 := trunc(abs(Y4)/10); if Y5 > 0 then
begin if Y5 > 10 then Y5 := Y5 - 10;
I := 5; J := round(Y-3); K := Y5; Numbers
end;
Y6 := abs(Y4) - 10 * Y5;
if Y6 >= 100 then Y6 := trunc(Y6 / 10);
I := 11; J := round(Y-3); K :=Y6; Numbers
end;
Y4 := Y4 + Y3; Y := Y + 200 * Y3 / (Y1 - Y2)
until Y > 199
end;
procedure ScreenPrint;
begin TempR := F/F7; write(TempR); gotoXY(28,whereY);
TempR := GA; RealsForm; write(TempS); gotoXY(44,whereY);
TempR := TH; RealsForm; writeln(TempS)
end;
procedure PrinterPrint;
begin TempR := F/F7; write(lst,TempR,' ');
TempR := GA; RealsForm; write(lst,TempS,' ');
TempR := TH; RealsForm; writeln(lst,TempS)
end;
procedure SweepLoop
;
begin F := F1; LA := 0.0; LR := 0.0; LT := 0.0; LM := 0.0; LX := 0.0;
LRET := 0.0; X := 0.0; D := 1; F4 := F3; TestForLine;
repeat W := 2 * pi * F;
if RLOS = 'Y' then
begin D1 := NI; D2 := 2;
if FLGL then LoadArrayLine; Determinant; V := B2; TH := D2;
if frac((NI+NO)/2) > 0 then TH := TH - 180;
D1 := NI; D2 := NI; Determinant;
THRET := TH - D2; VRET := V / B2;
if VRET <> 0.0 then
begin if VRET < 0.49999 then GRET := VRET * 2.0
else if VRET > 0.50001 then GRET := (1-VRET) * 2.0
else GRET := 0.99998;
GRET := abs(GRET * sqr(sqr(cos(THRET * PI / 180))));
GRET := 22 - 4.45 * (ln(1 - GRET) * 20 / ln(10));
draw(round(LX),round(LRET),round(X),round(GRET),3);
end; LRET:=GRET;
end;
D1 := NI; D2 := NO;
if FLGL then LoadArrayLine; Determinant; V := B2; TH := D2;
if frac((NI+NO)/2) > 0 then TH := TH - 180;
D1 := NI; D2 := NI; Determinant;
TH := TH - D2; Sound(1000); Delay(1); NoSound; V := V / B2;
if V <> 0.0 then
begin draw(round(LX),199,round(X),199,1); GA := ln(V)* 20/ln(10);
if (D>1) and (TM='Y') then begin TT := (TL-TH)/(F-FL)/360;
if TT>1E-20 then MM := (ln(T1*1E-6)-ln(TT))*200/ln(T1/T2); end;
FL := F; TL := TH;
if FLG = 0 then
begin GA := 199 * (Y1 - GA) / (Y1 - Y2);
draw(round(LX), round(LA), round(X), round(GA), 2);
while TH > 0.0 do begin TH := TH - 360 end;
while TH < -360 do begin TH := TH + 360 end;
TH := -200 * TH / 405 + 22; if TH > 199 then TH := TH - 200;
if PS = 'Y' then
draw(round(LX), round(LT), round(X), round(TH), 1);
if (D>2) and (TM='Y') then
draw(round(LX), round(ML), round(X), round(MM), 3);
end;
Last[1,D] := X; Last[2,D] := GA; Last[3,D] := TH;
Last[4,D] := MM; Last[5,D] := GRET;
if FLGA then
begin if ((abs(GA-LA)>5) or (abs(TH-LT)>5)) and (F4<500)
then F4:=F4*2; if ((abs(GA-LA)<2) or (GA>202)) and (X<300)
and (abs(TH-LT)<2) and (F4>20) then F4 := round(F4/2)
end;
LA := GA; LT := TH; LM := 0.0; LX := X; ML := MM; D := D + 1;
if D > 300 then D := 300;
if KeyPressed then
begin read(kbd,Ch);
case Ch of
'T','t' : begin F4 := round(F4/2); FLGA := false; end;
'H','h' : begin F4 := F4*2; FLGA := false; end;
'P','p' : PS:='Y';
'R','r' : RLOS := 'Y';
'O','o' : begin PS:='N'; RLOS := 'N'; end;
'A','a' : FLGA := true;
#27 : F:=F2*2
end
end;
if FLG = 1 then ScreenPrint;
if FLG = 2 then PrinterPrint;
X := X + 319 / F4;
if F2/F1 < 3 then F := F + (F2-F1) / F4
else F := F * exp(1 / F4 * ln(F2 / F1));
end
else
begin TextMode(C80); Beep; Delay(200);Beep; Delay(200); Beep;
gotoXY(15,10); writeln('Error in Input Data'); F := F2 * 2
end
until F > F2 + 2*(F2-F1)/F4;
Last[1,D] := 300; Beep; FLGL := false
end;
procedure ChangeUnits;
begin repeat clrscr; writeln('Current Units are'); writeln;
writeln('1 ',F7S); writeln('2 ',R7S);
writeln('3 ',C7S); writeln('4 ',L7S);
writeln('5 Normal Units (MHz ohm pf uh)'); read(kbd,Ch);
case CH of
'1' : begin if F7 = 1E9 then begin F7:=1; F7S:=' Hz' end else
begin if F7 = 1E6 then begin F7:=1E9; F7S:='GHz' end;
if F7 = 1E3 then begin F7:=1E6; F7S:='MHz' end;
if F7 = 1 then begin F7:=1E3; F7S:='kHz' end end
end;
'2' : begin if R7 = 1E6 then begin R7:=1; R7S:='ohm ' end else
begin if R7 = 1E3 then begin R7:=1E6; R7S:='Mohm' end;
if R7 = 1 then begin R7:=1E3; R7S:='kohm' end end
end;
'3' : begin if C7 = 1E-12 then begin C7:=1E-6; C7S:='uf ' end else
begin if C7 = 1E-9 then begin C7:=1E-12; C7S:='pf ' end;
if C7 = 1E-6 then begin C7:=1E-9; C7S:='nf ' end end
end;
'4' : begin if L7 = 1 then begin L7:=1E-3; L7S:='mh ' end else
begin if L7 = 1E-9 then begin L7:=1; L7S:='hy ' end;
if L7 = 1E-6 then begin L7:=1E-9; L7S:='nh ' end;
if L7 = 1E-3 then begin L7:=1E-6; L7S:='uh ' end end
end;
'5' : Units
end;
until (Ch=#13) or (Ch=#32)
end;
procedure EnterData;
begin clrscr; writeln(' Name of Circut is ',CirName); writeln;
writeln; writeln('E to Exit'); write('Use 8 or less characters,');
writeln(' with no spaces, the first being a letter');
gotoXY(29,1); read(TempS); Ch := 'X';
while (TempS<>'E') and (TempS<>'e') and (Ch<>#13) do
begin if TempS <> '' then CirName := TempS;
ClearData; I:=0; J:=0; K:=0; L:=0; N:=0; NC:=0; NoGraph;
repeat repeat repeat
clrscr; writeln(' Name of Circut is ',CirName); writeln;
UnitsAre; ND:=0; NI:=0; NO:=0;
writeln; writeln('No of Nodes = ');
gotoXY(15,5); read(Ch1); val(Ch1,ND,Err);
if (ND>NoN) or (ND<3) then Beep
until (ND<=NoN) and (ND>2);
gotoXY(22,5); write('Input = ');
read(Ch1); val(Ch1,NI,Err);
if (NI=0) or (NI>ND) then Beep
until (NI>0) and (NI<=ND);
gotoXY(36,5); write('Output = ');
readln(Ch1); val(Ch1,NO,Err);
if (NO=0) or (NO>ND) then Beep
until (NO>0) and (NO<=ND);
write(' Comp Value Nodes---');
repeat writeln; NC := NC + 1; gotoXY(1,whereY);
write(NC,' R/C/I/O/F/B/L'); gotoXY(5,whereY); read(kbd,Ch);
case Ch of
'R','r' : Resistor;
'C','c' : Capacitor;
'I','i' : Inductor;
'O','o' : OpAmp;
'F','f' : FET;
'B','b' : BiPolarT;
'L','l' : Line;
#13 : begin end
else begin Beep; NC := NC - 1; gotoXY(5,whereY-1); end
end
until Ch = #13
end; NC := NC - 1
end;
procedure ScreenL;
begin if I < 10 then write(I,' ') else write(I,' ');
case Compo[I] of
'R' : begin write('Res '); TempR := Value[1,I]/R7; RealsForm;
write(TempS,' ',R7S,' ');
write(Nodes[1,I],' ',Nodes[2,I]) end;
'C' : begin write('Cap '); TempR := Value[1,I]/C7; RealsForm;
write(TempS,' ',C7S,' ');
write(Nodes[1,I],' ',Nodes[2,I]) end;
'I' : begin write('Ind '); TempR := Value[1,I]/L7; RealsForm;
write(TempS,' ',L7S,' ');
write(Nodes[1,I],' ',Nodes[2,I]) end;
'O' : begin write('OpA ');
TempR := Value[2,I]; RealsForm; write(TempS,' G(V) ');
TempR := Value[1,I]/R7; RealsForm; write(TempS,' ',R7S,'O ');
write(Nodes[3,I],' +In ',Nodes[4,I],' -In '
,Nodes[2,I],' +Out ',Nodes[1,I],' -Out ') end;
'F' : begin write('FET '); TempR := Value[1,I]; RealsForm;
write(TempS,' Gain(A/V) ');
write(Nodes[2,I],' S ',Nodes[3,I],' G '
,Nodes[1,I],' D ') end;
'B' : begin write('BiPolar '); TempR := Value[2,I]; RealsForm;
write(TempS,' Beta '); TempR := Value[1,I]/R7; RealsForm;
write(TempS,' ',R7S,' B/E ');
write(Nodes[2,I],' E ',Nodes[3,I],' B '
,Nodes[1,I],' C ') end;
'L' : begin write('Line '); TempR := Value[2,I]/F7; realsForm;
write(TempS,' ',F7S,' L/4 ');
TempR := Value[1,I]/R7; RealsForm; write(TempS,' ',R7S,' ');
write(Nodes[3,I],' Lin ',Nodes[4,I],' Gin '
,Nodes[2,I],' Lout ',Nodes[1,I],' Gout ') end
end;
writeln
end;
procedure ScreenList;
begin clrscr;
writeln(' Name of Circut is ',CirName); writeln; UnitsAre;
writeln(' No of Nodes = ',ND,' Input = ',NI,' Output = ',NO);
writeln(' Comp Value Nodes---');
for I := 1 to NC do
begin if I = 20 then read(kbd,Chm); ScreenL end;
read(kbd,Chm)
end;
procedure PrinterList;
begin writeln(lst,' Name of Circut is ',CirName);
writeln(lst,' Units are: ',F7S,' ',R7S,' ',C7S,' ',L7S);
writeln(lst,' No of Nodes = ',ND,' Input = ',NI,' Output = ',NO);
writeln(lst,' Comp Value Nodes---');
for I := 1 to NC do
begin if I < 10 then write(lst,I,' ') else write(lst,I,' ');
case Compo[I] of
'R' : begin write(lst,'Res '); TempR := Value[1,I]/R7; RealsForm;
write(lst,TempS,' ',R7S,' ');
write(lst,Nodes[1,I],' ',Nodes[2,I]) end;
'C' : begin write(lst,'Cap '); TempR := Value[1,I]/C7; RealsForm;
write(lst,TempS,' ',C7S,' ');
write(lst,Nodes[1,I],' ',Nodes[2,I]) end;
'I' : begin write(lst,'Ind '); TempR := Value[1,I]/L7; RealsForm;
write(lst,TempS,' ',L7S,' ');
write(lst,Nodes[1,I],' ',Nodes[2,I]) end;
'O' : begin write(lst,'OpA ');
TempR := Value[2,I]; RealsForm; write(lst,TempS,' G(V) ');
TempR := Value[1,I]/R7; RealsForm; write(lst,TempS,' ',R7S,'O ');
write(lst,Nodes[3,I],' +In ',Nodes[4,I],' -In '
,Nodes[2,I],' +Out ',Nodes[1,I],' -Out ') end;
'F' : begin write(lst,'FET '); TempR := Value[1,I]; RealsForm;
write(lst,TempS,' Gain(A/V) ');
write(lst,Nodes[2,I],' S ',Nodes[3,I],' G '
,Nodes[1,I],' D ') end;
'B' : begin write(lst,'BiPolar '); TempR := Value[2,I]; RealsForm;
write(lst,TempS,' Beta'); TempR := Value[1,I]/R7; RealsForm;
write(lst,TempS,' ',R7S,' B/E ');
write(lst,Nodes[2,I],' E ',Nodes[3,I],' B '
,Nodes[1,I],' C ') end;
'L' : begin write(lst,'Line '); TempR := Value[2,I]/F7; realsForm;
write(lst,TempS,' ',F7S,' L/4 ');
TempR := Value[1,I]/R7; RealsForm; write(lst,TempS,' ',R7S,' ');
write(lst,Nodes[3,I],' Lin ',Nodes[4,I],' Gin '
,Nodes[2,I],' Lout ',Nodes[1,I],' Gout ') end;
end;
writeln(lst)
end; writeln(lst); writeln(lst); writeln(lst)
end;
procedure DeleteComp;
begin
for I := NC to NN do
begin
Compo[I] := Compo[I+1];
Value[1,I] := Value[1,I+1];
Value[2,I] := Value[2,I+1];
Nodes[1,I] := Nodes[1,I+1];
Nodes[2,I] := Nodes[2,I+1];
Nodes[3,I] := Nodes[3,I+1];
Nodes[4,I] := Nodes[4,I+1];
end;
NN := NN - 1; NC := NN;
for I := 6 to 24 do begin gotoXY(1,I); ClrEol; end;
gotoXY(1,6); writeln(' Comp Value Nodes---');
for I := 1 to NC do
begin if I = 20 then read(kbd,Ch); Ch := #0; ScreenL end;
writeln; writeln('No. Comp Value Nodes---');
end;
procedure Correct;
begin clrscr; writeln('Correction Mode'); writeln;
writeln(' Name of Circut is ',CirName);
gotoXY(29,3); read(TempS);
if TempS <> '' then CirName := TempS; gotoXY(29,3);
writeln(CirName,' '); UnitsAre;
gotoXy(4,5); write('No of Nodes = ',ND);
gotoXY(22,5); write('Input = ',NI);
gotoXY(34,5); write('Output = ',NO);
repeat repeat repeat gotoXY(18,5); read(Ch1);
if Ch1 <> '' then val(Ch1,ND,Err); gotoXY(18,5); write(ND,' ');
if (ND<3) or (ND>NoN) then Beep
until (ND>2) and (ND<=NoN); gotoXY(30,5); read(Ch1);
if Ch1 <> '' then val(Ch1,NI,Err); gotoXY(30,5);
write(NI,' '); if NI > ND then Beep
until NI <= ND; gotoXY(43,5); read(Ch1);
if Ch1 <> '' then val(Ch1,NO,Err); gotoXY(43,5);
write(NO,' '); if NO > ND then Beep
until NO <= ND; writeln;
writeln(' Comp Value Nodes---');
for I := 1 to NC do
begin if I = 20 then read(kbd,Ch); ScreenL end;
writeln; writeln('No. Comp Value Nodes---');
NN := NC;
repeat
read(Ch1); val(Ch1,NC,Err);
if (Ch1='') or (NC=0) or (NC>NN+1) then Ch := #13 else
begin if NC = NN + 1 then begin NN:=NN+1; Compo[NC]:='D'; end;
gotoXY(1,whereY); write(NC,' R/C/I/O/F/B/L D');
repeat FLGC := true; gotoXY(5,whereY); write(Compo[NC]);
gotoXY(5,whereY); read(kbd,Ch);
if Ch <> #13 then Compo[NC]:=Ch;
Ch:=Compo[NC];
gotoXY(5,whereY); write(Compo[NC]);
case Ch of
'R','r' : begin Resistor;writeln; end;
'C','c' : begin Capacitor;writeln; end;
'I','i' : begin Inductor;writeln; end;
'O','o' : begin OpAmp; writeln; end;
'F','f' : begin FET; writeln; end;
'B','b' : begin BiPolarT;writeln; end;
'L','l' : begin Line; writeln; end;
'D','d' : DeleteComp;
#13 : begin end
else begin Beep; FLGC := false; end
end
until FLGC
end
until Ch = #13;
NC := NN
end;
procedure ShowDir(FileSpec : String80; Attr : byte);
{ManipulatingDiskFiles"TURBO PASCAL TIPS,TRICKS&TRAPS"QUEbyRugg&Feldman}
type RegList = record
AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : integer
end;
const Columns = 5;
var J, ColSize : integer;
Reg : RegList;
DTA : array[1..43] of byte;
begin ColSize := 80 div Columns; Reg.DX := ofs(DTA);
Reg.DS := seg(DTA); Reg.AX := $1A00; msdos(Reg);
writeln('** Directory listing for ',FileSpec);
FileSpec := FileSpec + chr(0); Reg.DX := ofs(FileSpec[1]);
Reg.DS := seg(FileSpec[1]); Reg.CX := Attr; Reg.AX := $4E00;
msdos(Reg);
if lo(Reg.AX) <> 0 then
begin writeln('** No filenames found. **'); exit end;
if DTA[22] and $18 <> 0 then write('[D]'); J := 31;
while DTA[J] <> 0 do
begin write(chr(DTA[J])); J := J + 1 end;
repeat Reg.DX := ofs(DTA); Reg.DS := seg(DTA); Reg.AX := $4F00;
msdos(Reg);
if lo(Reg.AX) = 0 then
begin if whereX > (Columns - 1) * ColSize + 1 then writeln;
while (whereX mod ColSize) <> 1 do write(' ');
if DTA[22] and $10 <> 0 then write('[D]'); J := 31;
while DTA[J] <> 0 do begin write(chr(DTA[J])); J := J + 1 end
end
until lo(Reg.AX) <> 0;
writeln; writeln('** End of directory listing. **')
end;
procedure LoadData;
begin clrscr; ShowDir('B:*.*',$10); writeln;
writeln('Name of Circuit to load is (exclude extension .NOD) ');
write('E to exit'); gotoXY(53,whereY-1); readln(TempS);
while (TempS <> 'E') and (TempS <> 'e') and (TempS <> '') do
begin writeln('Loading KBD Data from Disk B:'); CirName := TempS;
CircuitName := 'B:' + CirName + '.NOD';
assign(Infile, CircuitName);
reset(Infile);
read(Infile,KbdRecord); F7S := KbdRecord.Parts;
F7 := KbdRecord.Value1; R7 := KbdRecord.Value2;
NC := KbdRecord.Nodes1; ND := KbdRecord.Nodes2;
NI := KbdRecord.Nodes3; NO := KbdRecord.Nodes4;
read(Infile,KbdRecord); R7S := KbdRecord.Parts;
C7 := KbdRecord.Value1; L7 := KbdRecord.Value2;
F3 := KbdRecord.Nodes1; Y1 := KbdRecord.Nodes2;
Y2 := KbdRecord.Nodes3; TempI := KbdRecord.Nodes4;
if TempI = 1 then FLGA := true else FLGA := false;
read(Infile,KbdRecord); C7S := KbdRecord.Parts;
F1 := KbdRecord.Value1; F2 := KbdRecord.Value2;
read(Infile,KbdRecord); L7S := KbdRecord.Parts;
for I := 1 to NC do
begin read(Infile,KbdRecord); Compo[I] := KbdRecord.Parts;
Value[1,I] := KbdRecord.Value1; Value[2,I] := KbdRecord.Value2;
Nodes[1,I] := KbdRecord.Nodes1; Nodes[2,I] := KbdRecord.Nodes2;
Nodes[3,I] := KbdRecord.Nodes3; Nodes[4,I] := KbdRecord.Nodes4
end;
close(Infile); TempS := 'E'
end
end;
procedure SaveData;
begin if NC > 1 then
begin clrscr; ShowDir('B:*.*',$10); writeln;
writeln('Name of Circut to save is ',CirName);
write('E to exit'); gotoXY(27,whereY-1); readln(TempS);
while (TempS <> 'E') and (TempS <> 'e') do
begin if TempS <> '' then CirName := TempS; gotoXY(27,whereY-1);
writeln(CirName,' '); writeln;
writeln('Saving KBD Data to Disk B:'); writeln;
writeln('Name of Circuit is ',CirName);
CircuitName := 'B:' + CirName + '.NOD';
assign(Outfile, CircuitName);
rewrite(Outfile); KbdRecord.Parts := F7S;
KbdRecord.Value1 := F7; KbdRecord.Value2 := R7;
KbdRecord.Nodes1 := NC; KbdRecord.Nodes2 := ND;
KbdRecord.Nodes3 := NI; KbdRecord.Nodes4 := NO;
write(Outfile, KbdRecord); KbdRecord.Parts := R7S;
KbdRecord.Value1 := C7; KbdRecord.Value2 := L7;
KbdRecord.Nodes1 := F3; KbdRecord.Nodes2 := Y1;
if FLGA then TempI := 1 else TempI := 0;
KbdRecord.Nodes3 := Y2; KbdRecord.Nodes4 := TempI;
write(Outfile, KbdRecord); KbdRecord.Parts := C7S;
KbdRecord.Value1 := F1; KbdRecord.Value2 := F2;
KbdRecord.Nodes1 := 0; KbdRecord.Nodes2 := 0;
KbdRecord.Nodes3 := 0; KbdRecord.Nodes4 := 0;
write(Outfile, KbdRecord); KbdRecord.Parts := L7S;
KbdRecord.Value1 := 0.0; KbdRecord.Value2 := 0.0;
KbdRecord.Nodes1 := 0; KbdRecord.Nodes2 := 0;
KbdRecord.Nodes3 := 0; KbdRecord.Nodes4 := 0;
write(Outfile, KbdRecord);
for I := 1 to NC do
begin KbdRecord.Parts := Compo[I];
KbdRecord.Value1 := Value[1,I]; KbdRecord.Value2 := Value[2,I];
KbdRecord.Nodes1 := Nodes[1,I]; KbdRecord.Nodes2 := Nodes[2,I];
KbdRecord.Nodes3 := Nodes[3,I]; KbdRecord.Nodes4 := Nodes[4,I];
write(Outfile, KbdRecord)
end;
close(Outfile); Delay(1000); TempS := 'E'
end
end
else begin clrscr; Beep; writeln('Enter Circuit !!'); Delay(2000) end
end;
procedure ScreenSweep;
begin clrscr; writeln(' The Name of Circuit is ',CirName);
if NC > 1 then
begin FreqLimits; LoadArray; writeln;
writeln(' Freq ',F7S,' Gain dB Phase deg');
FLG := 1; SweepLoop; FLG := 0; read(kbd,Chm)
end else begin writeln('Enter Circuit !!'); Beep; Delay(2000) end
end;
procedure PrinterSweep;
begin clrscr; writeln(' The Name of Circuit is ',CirName);
if NC > 1 then
begin FreqLimits; LoadArray;
writeln(lst,' The Name of Circuit is ',CirName); writeln(lst);
writeln(lst,' Freq ',F7S,' Gain dB Phase deg');
FLG := 2; SweepLoop; FLG := 0
end else begin writeln('Enter Circuit !!'); Beep; Delay(2000) end
end;
procedure IfKeyPress;
begin if KeyPressed then begin read(kbd,Chm) end;
if KeyPressed then begin read(kbd,Chm) end;
if KeyPressed then begin read(kbd,Chm) end;
read(kbd,Chm); TextMode(C80)
end;
procedure GraphSweep;
begin clrscr; if NC > 1 then
begin SweepStart; FreqLimits; GainLimits;
if TM='Y' then TimeLimits; GraphColorMode;
draw(0,0,319,0,1); draw(319,0,319,200,1); draw(0,199,0,0,1);
if F2 / F1 < 3 then LinearFreqGrid else LogFreqGrid; FreqLabel;
GainGrid; GainLabel; if(PS='Y')and(TM='N')and(RLOS='N')then PhaseLabel;
if (TM='Y') and (RLOS='N') then TimeLabel; if RLOS='Y' then RetLossLabel;
LoadArray; SweepLoop; IfKeyPress;
end else begin writeln('Enter Circuit !!'); Beep; Delay(2000) end
end;
procedure GraphLabel;
begin GraphColorMode; draw(0,0,319,0,1);
draw(319,0,319,199,1); draw(0,199,0,0,1);
if F2 / F1 < 3 then LinearFreqGrid else LogFreqGrid; FreqLabel;
GainGrid; GainLabel; if (PS='Y')and(TM='N')and(RLOS='N') then PhaseLabel;
if (TM='Y') and (RLOS='N') then TimeLabel; if RLOS='Y' then RetLossLabel;
LA := 0; LT := 0; LX := 0; D := 1;
end;
Procedure DrawOverLast;
begin repeat draw(round(LX),round(LA),round(Last[1,D]),round(Last[2,D]),1);
if PS='Y' then begin draw(round(LX),round(LT),round(Last[1,D]),
round(Last[3,D]),1); LT := Last[3,D]; end;
if TM='Y' then begin if D > 2 then draw(round(LX),round(ML),
round(Last[1,D]), round(Last[4,D]),1); ML := Last[4,D]; end;
if RLOS='Y' then begin draw(round(LX),round(LRET),round(Last[1,D]),
round(Last[5,D]),1); LRET:= Last[5,D]; end;
LX := Last[1,D]; LA := Last[2,D]; D := D + 1 until Last[1,D] = 300;
end;
Procedure DrawOverRef;
begin repeat draw(round(LX),round(LA),round(Ref[1,D]),round(Ref[2,D]),1);
if PS='Y' then begin draw(round(LX),round(LT),round(Ref[1,D]),
round(Ref[3,D]),1); LT := Ref[3,D]; end;
if TM='Y' then begin if D > 2 then draw(round(LX),round(ML),
round(Ref[1,D]), round(Ref[4,D]),1); ML := Ref[4,D]; end;
if RLOS='Y' then begin draw(round(LX),round(LRET),round(Ref[1,D]),
round(Ref[5,D]),1); LRET:= Ref[5,D]; end;
LX := Ref[1,D]; LA := Ref[2,D]; D := D + 1 until Ref[1,D] = 300;
end;
procedure OverGraph;
begin if NC > 1 then
begin if Last[1,1] <> 300 then
begin GraphLabel; DrawOverLast; LoadArray; SweepLoop; IfKeyPress;
end else begin clrscr; writeln('No Graph !!'); Beep; Delay(2000) end
end else begin clrscr; writeln('Enter Circuit !!'); Beep; Delay(2000) end
end;
procedure OverRefGraph;
begin if NC > 1 then
begin if Ref[1,1] <> 300 then
begin GraphLabel; DrawOverRef; LoadArray; SweepLoop; IfKeyPress;
end else begin clrscr; writeln('Save Ref Graph !!');Beep;Delay(2000) end
end else begin clrscr; writeln('Enter Circuit !!'); Beep; Delay(2000) end
end;
procedure OverLastAndRefGraph;
begin if NC > 1 then
begin if Ref[1,1] <> 300 then
begin GraphLabel; DrawOverLast; LA := 0; LT := 0; LX := 0; D := 1;
DrawOverRef; LoadArray; SweepLoop; IfKeyPress;
end else begin clrscr; writeln('Save Ref Graph !!');Beep;Delay(2000) end
end else begin clrscr; writeln('Enter Circuit !!'); Beep; Delay(2000) end
end;
procedure StoreRefGraph;
begin if Last[1,1] <> 300 then
begin for I := 1 to 5 do
begin for J := 1 to 300 do Ref[I,J] := Last[I,J] end
end else begin clrscr; writeln('No Last Graph !!');Beep;Delay(2000) end
end;
procedure ViewGraph;
begin if Last[1,1] <> 300 then
begin GraphLabel; DrawOverLast; IfKeyPress;
end else begin clrscr; writeln('No Last Graph !!');Beep; Delay(2000) end
end;
procedure ViewRefGraph;
begin if Ref[1,1] <> 300 then
begin GraphLabel; DrawOverRef; IfKeyPress;
end else begin clrscr; writeln('No Ref Graph !!');Beep; Delay(2000) end
end;
procedure Instructions;
begin
clrscr; writeln(' This is a nodal program that has a minimum of 3 and');
writeln('a maximum of ',NoN,' nodes.');
writeln(' It will model resistors, capacitors, inductors, ');
writeln('opamps, transmission lines, field effect & bipolar transistors.');
writeln(' A maximim of ',NoC,' components can be entered.');
writeln(' Components can be added in the correction mode if ');
writeln('the next higher component number is used, or deleated by');
writeln('using the D key.');
writeln(' If the frequency sweep ratio is < 3 the sweep is');
writeln('linear, otherwise the sweep is logarithmic.');
writeln(' When the sweep is logarithmic, the decade frequency label');
writeln('is the exponent of the frequency, or K, M or G.');
writeln(' If only one computation is desired, allow 2');
writeln('computations by selecting the desired frequency as the start,');
writeln('a higher frequency as the stop and 1 step as the increment.');
writeln(' A maximim of 300 points are stored for last and ref graphs.');
writeln(' During frequency sweep, an ESC key will exit.');
writeln(' An A key is for turning on automatic step size.');
writeln(' A T key is for changing to twice step size, auto off.');
writeln(' An H key is for changing to half step size, auto off.');
writeln(' An P key is for turning phase plot on.');
writeln(' An R key is for turning return loss plot on.');
writeln(' An O key is for turning phase or return loss plot off');
read(kbd,Chm);
writeln(' Time is computed using the last and present computations');
writeln(' For Return Loss, node 1 must be input and a source resistor');
writeln(' must be from node 1 to node 2.');
writeln(' The right edge labeling will be phase, time or return loss');
writeln(' whichever is last selected.');
writeln(' When using an open circuited transmission line, load the');
writeln('open end with a 1 M resistor.');
writeln(' A t or T key in Menu will load test Ckts.');
writeln; writeln('Ref EDN Sept 1, 1982 Nodal equations');
writeln(' RF DESIGN EXPO 86 Transmission line equations');
writeln; writeln('Rev. ',TDN);
read(kbd,Chm)
end;
procedure Test1;
begin clrscr; writeln('Entering Test 1 Circuit');
ClearData; ClearDeter; Units; Y1:=5; Y2:=-40; FLGA := false;
Last[1,1] := 300; Ref[1,1] := 300; I := 0; J := 0; K := 0;
L := 0; N := 0; F3 := 20; PS:='Y'; TM:='N'; RLOS:='N';
CirName:='Test1'; ND:=3; NI:=1; NO:=3; F1:=1E3; F2:=1E9; NC:=4;
Compo[1]:='R'; Compo[2]:='R'; Compo[3]:='R'; Compo[4]:='C';
Value[1,1]:=50; Value[1,2]:=0.0001; Value[1,3]:=50; Value[1,4]:=1E-8;
Nodes[1,1]:=1; Nodes[1,2]:=2; Nodes[1,3]:=3; Nodes[1,4]:=3;
nodes[2,1]:=2; Nodes[2,2]:=3; Nodes[2,3]:=0; Nodes[2,4]:=0
end;
procedure Test2;
begin clrscr; writeln('Entering Test 2 Circuit');
ClearData; ClearDeter; Units; Y1:=0; Y2:=-100; FLGA := true;
Last[1,1] := 300; Ref[1,1] := 300; I := 0; J := 0; K := 0;
L := 0; N := 0; F3 := 20; PS:='Y'; TM:='N'; RLOS:='N';
CirName:='Test2'; ND:=3; NI:=1; NO:=3; F1:=1E3; F2:=1E9; NC:=4;
Compo[1]:='R'; Compo[2]:='I'; Compo[3]:='C'; Compo[4]:='R';
Value[1,1]:=50; Value[1,2]:=1E-3; Value[1,3]:=1E-11; Value[1,4]:=50;
Nodes[1,1]:=1; Nodes[1,2]:=2; Nodes[1,3]:=2; Nodes[1,4]:=3;
nodes[2,1]:=2; Nodes[2,2]:=3; Nodes[2,3]:=3; Nodes[2,4]:=0
end;
procedure Menu;
begin repeat repeat clrscr;
writeln(' NODAL NETWORK ANALYZER'); writeln;
writeln('Name of Circut is ',CirName); writeln;
writeln('1 Enter Data From Kbd');
writeln('2 Change Units');
writeln('3 List Kbd Data to Screen');
writeln('4 List Kbd Data to Printer');
writeln('5 Correct Kbd Data');
writeln('6 Load Kbd Data from Disk B:');
writeln('7 Save Kbd Data to Disk B:');
writeln('8 Freq Sweep Tabular to Screen');
writeln('9 Freq Sweep Tabular to Printer');
writeln('0 Freq Sweep to Graph');
writeln('- Freq Sweep over last Graph');
writeln('= Freq Sweep over ref Graph');
writeln('+ Freq Sweep over last & ref Graph');
writeln('S Store last Graph as ref Graph');
writeln('V View last Graph');
writeln('B View ref Graph');
writeln('I Instructions');
writeln('EE END');
read(kbd,Chm);
case Chm of
'1' : EnterData; '2' : ChangeUnits; '3' : ScreenList;
'4' : PrinterList; '5' : Correct; '6' : LoadData;
'7' : SaveData; '8' : ScreenSweep; '9' : PrinterSweep;
'0' : GraphSweep; '-' : OverGraph; '=' : OverRefGraph;
'+' : OverLastAndRefGraph; 'S','s' : StoreRefGraph;
'V','v' : ViewGraph; 'B','b' : ViewRefGraph;
'I','i' : Instructions; 't' : Test1; 'T' : Test2;
end
until (Chm='E') or (Chm='e'); read(kbd,Chm);
until (Chm='E') or (Chm='e')
end;
BEGIN
CirName := ' '; ClearData; ClearDeter; PS := 'N'; TM := 'N'; RLOS := 'N';
F1 := 1E6; F2 := 2E6; F3 := 20; Y1 := 0; Y2 := -40; ND := 3;
NI := 1; NO := 3; NC := 0; T1 := 10; T2 := 1E-3;
FLG := 0; Last[1,1] := 300; Ref[1,1] := 300; Units; FLGA := false; Menu
END.