HAM Radio 1

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 | 58.5 KB | 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.