home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / tech / design3 / nodnet.pas < prev    next >
Pascal/Delphi Source File  |  1987-07-22  |  60KB  |  1,379 lines
  1.  
  2. { Written for Apple II Mar 83...  by Charles J Dockstader
  3.   Modified many times
  4.   Nodal equations see EDN Sept 1 1982
  5.   Transmission line equations see RF DESIGN EXPO 86
  6.   Converted to GWBasic Oct 86  by CJD
  7.   Converted to Pascal Dec 86...  by CJD}
  8. program NODNET;
  9.   const TDN = '6 53 PM July 22 1987 Charles J Dockstader';
  10.         NoN = 25;      {Max No of Nodes}
  11.         NoC = 40;      {Max No of Components}
  12.   type NNKbdRecord = RECORD
  13.          Parts : string[4];
  14.          Value1, Value2 : real;
  15.          Nodes1, Nodes2, Nodes3, Nodes4 : integer;
  16.        end;
  17.       String80 = string[80];
  18.   var KbdRecord : NNKbdRecord;
  19.       Infile, Outfile : File of NNKbdRecord;
  20.       Compo : array[1..NoC] of string[4];
  21.       Nodes : array[1..4] of array[1..NoC] of integer;
  22.       Value : array[1..2] of array[1..NoC] of real;
  23.       Last : array[1..5] of array[1..300] of real;
  24.       Ref : array[1..5] of array[1..300] of real;
  25.       A : array[1..NoN] of array[1..NoN] of real;
  26.       B : array[1..NoN] of array[1..NoN] of real;
  27.       B1 : array[1..NoN] of array[1..NoN] of real;
  28.       P : array[1..NoN] of array[1..NoN] of real;
  29.       Q : array[1..NoN] of array[1..NoN] of real;
  30.       Q1 : array[1..NoN] of array[1..NoN] of real;
  31.       S : array[1..NoN] of array[1..NoN] of real;
  32.       B2, C7, D1, D2, F, F1, F2, F7, FL, FT, GA, G2, G3, G4, G5, G6, G7,
  33.          G8, L7, LA, LM, LR, LT, LX, ML, MM, Q2, R7, RR, S1, S2, T, T1,
  34.          T2, TH, TL, TT, V, W, X, Y, GRET, LRET, THRET, VRET, TempR: real;
  35.       D, F3, F4, FLG, I, J, J2, K, L, LF, M, N, N1, NC, ND,
  36.          NI, NN, NO, Nod, Nx, PL, QL, RL, R1, R2, X1, Y0,
  37.          Y1, Y2, Y3, Y4, Y5, Y6, Err, TempI: integer;
  38.       FLGA, FLGB, FLGC, FLGL : boolean;
  39.       Ch, Chm : char;
  40.       PS, TM, RLOS : string[1];
  41.       Ch1 : string[2];
  42.       F7S, R7S, C7S, L7S, Comp: string[4];
  43.       CirName: string[8];
  44.       TempS : string[10];
  45.       CircuitName : string[14];
  46.  
  47. procedure Beep;
  48.   begin Sound(440); Delay(150); NoSound end;
  49.  
  50. procedure Zero;
  51.   begin draw(I-1,J,I+1,J,1); draw(I+2,J+1,I+2,J+5,1);
  52.     draw(I+1,J+6,I-1,J+6,1); draw(I-2,J+5,I-2,J+1,1) end;
  53.  
  54. procedure One;
  55.   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;
  56.  
  57. procedure Two;
  58.   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);
  59.     draw(I-2,J+6,I+2,J+6,1) end;
  60.  
  61. procedure Three;
  62.   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
  63.     +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;
  64.  
  65. procedure Four;
  66.   begin draw(I+1,J,I+1,J+6,1); draw(I-2,J+4,I+2,J+4,1);
  67.     draw(I-2,J+3,I+1,J,1) end;
  68.  
  69. procedure Five;
  70.   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);
  71.     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;
  72.  
  73. procedure Six;
  74.   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);
  75.     draw(I+2,J+5,I+2,J+4,1); draw(I+1,J+3,I-1,J+3,1) end;
  76.  
  77. procedure Seven;
  78.   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;
  79.  
  80. procedure Eight;
  81.   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);
  82.     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);
  83.     draw(I-1,J+3,I+1,J+3,1) end;
  84.  
  85. procedure Nine;
  86.   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);
  87.     draw(I+1,J+3,I-1,J+3,1); draw(I-2,J+2,I-2,J+1,1) end;
  88.  
  89. procedure Decpt;
  90.    begin draw(I-5,J+5,I-4,J+5,1); draw(I-5,J+6,I-4,J+6,1); end;
  91.  
  92. procedure KKK;
  93.   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)
  94.   end;
  95.  
  96. procedure MMM;
  97.   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);
  98.     plot(I+1,J+1,1); Draw(I,J+2,I,J+3,1) end;
  99.  
  100. procedure GGG;
  101.   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
  102.   (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;
  103.  
  104. procedure FreqLabel;
  105.   begin
  106.     draw(137,179,134,179,1);draw(133,179,133,185,1);draw(136,182,134,182,1);
  107.     draw(139,185,139,180,1);draw(139,179,142,179,1);draw(143,180,143,181,1);
  108.     draw(140,182,142,182,1);draw(143,185,142,183,1);draw(149,179,146,179,1);
  109.     draw(145,179,145,184,1);draw(145,185,149,185,1);draw(146,182,148,182,1);
  110.     draw(154,179,152,179,1);draw(151,180,151,184,1);draw(152,185,154,185,1);
  111.     draw(155,180,155,186,1);draw(153,183,154,184,1);draw(157,179,157,184,1);
  112.     draw(158,185,160,185,1);draw(161,179,161,184,1);draw(167,179,164,179,1);
  113.     draw(163,179,163,184,1);draw(163,185,167,185,1);draw(166,182,164,182,1);
  114.     draw(169,179,169,185,1);draw(170,181,172,183,1);draw(173,179,173,185,1);
  115.     draw(178,179,176,179,1);draw(175,180,175,184,1);draw(176,185,178,185,1);
  116.     draw(181,179,181,180,1);draw(183,182,183,185,1);draw(185,179,185,180,1);
  117.     plot(179,180,1);plot(179,184,1);plot(182,181,1);plot(184,181,1)
  118.   end;
  119.  
  120. procedure GainLabel;
  121.   begin for I := 15 to 23 do draw(I,74,I,126,0);
  122.     draw(17,77,21,77,2);draw(19,75,19,79,2);draw(17,81,18,81,2);
  123.     draw(20,81,21,81,2);draw(16,82,16,85,2);draw(19,82,19,85,2);
  124.     draw(22,82,22,85,2);draw(16,85,22,85,2);draw(17,87,21,87,2);
  125.     draw(16,88,16,91,2);draw(22,88,22,91,2);draw(16,91,22,91,2);
  126.     draw(19,93,19,97,2);draw(16,105,22,105,2);draw(16,109,22,109,2);
  127.     draw(18,108,20,106,2);draw(16,112,21,112,2);draw(16,111,16,113,2);
  128.     draw(22,111,22,113,2);draw(16,117,17,116,2);draw(18,115,22,115,2);
  129.     draw(20,116,20,118,2);draw(18,119,22,119,2);plot(17,118,2);
  130.     draw(16,122,16,124,2);draw(17,125,21,125,2);draw(22,121,22,124,2);
  131.     draw(20,121,20,122,2);plot(21,121,2);plot(17,121,2)
  132.   end;
  133.  
  134. procedure PhaseLabel;
  135.   begin Y := 22.222;
  136.     repeat draw(283,round(Y),295,round(Y),1); Y := Y + 22.222 until Y > 190;
  137.     I:=314;J:=19;Zero; I:=308;J:=41;Four; I:=314;Five; I:=308;J:=63;Nine;
  138.     I:=314;Zero; I:=303;J:=86;One;  I:=308;Three; I:=314;Five;
  139.     I:=303;J:=108;One; I:=308;Eight; I:=314;Zero; I:=302;J:=130;Two;
  140.     I:=308;Two; I:=314;Five; I:=302;J:=152;Two; I:=308;Seven;
  141.     I:=314;Zero; I:=302;J:=175;Three; I:=308;One; I:=314;Five;
  142.     for I := 291 to 299 do draw(I,67,I,125,0); {Clr Screen}
  143.     draw(292,68,298,68,1);draw(295,69,295,71,1);draw(296,72,297,72,1);
  144.     draw(298,69,298,71,1);draw(292,74,298,74,1);draw(292,78,298,78,1);
  145.     draw(295,75,295,77,1);draw(292,80,296,80,1);draw(297,81,298,82,1);
  146.     draw(294,81,294,83,1);draw(292,84,296,84,1);plot(297,83,1);
  147.     draw(292,87,292,89,1);draw(293,90,294,90,1);draw(295,87,295,89,1);
  148.     draw(296,86,297,86,1);draw(298,87,298,89,1);plot(293,86,1);
  149.     plot(297,90,1);draw(292,96,292,93,1);draw(292,92,297,92,1);
  150.     draw(298,92,298,96,1);draw(295,93,295,95,1);draw(292,101,297,101,1);
  151.     draw(298,101,298,104,1);draw(297,105,293,105,1);draw(292,102,292,104,1);
  152.     draw(298,110,298,108,1);draw(298,107,293,107,1);draw(292,107,292,110,1);
  153.     draw(295,108,295,109,1);draw(293,112,297,112,1);draw(298,113,298,115,1);
  154.     draw(292,113,292,115,1);draw(292,116,294,116,1);plot(294,115,1);
  155.     plot(297,116,1);draw(295,118,295,122,1);
  156.   end;
  157.  
  158. procedure TimeLabel;
  159.   begin Y := 50;
  160.     repeat draw(283,round(Y),295,round(Y),3); Y := Y + 50 until Y > 190;
  161.     Y := 24;
  162.     repeat draw(283,round(Y),295,round(Y),3); Y := Y + 50 until Y > 190;
  163.     for I := 301 to 318 do draw(I,20,I,160,0);
  164.     I:=314;J:=21;Zero;Decpt;I:=305;Three;I:=314;J:=47;Zero;Decpt;
  165.     I:=306;One;I:=314;J:=71;Three;Decpt;I:=305;Zero;I:=314;J:=97;One;
  166.     Decpt;I:=305;Zero;I:=314;J:=121;Three;I:=308;Zero;Decpt;
  167.     I:=314;J:=147;One;I:=308;Zero;Decpt;I:=314;J:=171;Three;
  168.     I:=308;Zero;I:=302;Zero;Decpt;
  169.     for I := 292 to 300 do draw(I,56,I,142,0);
  170.     draw(299,57,299,61,3);draw(293,59,298,59,3);draw(293,63,293,65,3);
  171.     draw(294,64,298,64,3);draw(299,63,299,65,3);draw(293,67,299,67,3);
  172.     plot(298,68,3);draw(296,69,297,69,3);plot(298,70,3);
  173.     draw(293,71,299,71,3);draw(293,73,299,73,3);draw(293,74,293,77,3);
  174.     draw(296,74,296,76,3);draw(299,74,299,77,3);draw(293,84,299,84,3);
  175.     draw(293,85,293,87,3);draw(299,85,299,87,3);draw(294,88,298,88,3);
  176.     draw(293,90,299,90,3);draw(293,91,293,94,3);draw(296,91,296,93,3);
  177.     draw(299,91,299,94,3);draw(293,96,299,96,3);draw(293,97,293,100,3);
  178.     draw(293,102,297,102,3);plot(298,103,3);plot(299,104,3);
  179.     plot(298,105,3);draw(293,106,297,106,3);draw(295,103,295,105,3);
  180.     draw(293,110,296,110,3);draw(297,110,299,108,3);draw(297,110,299,112,3);
  181.     draw(294,119,297,119,3);draw(293,120,293,122,3);draw(294,123,297,123,3);
  182.     plot(294,125,3);draw(293,126,293,128,3);draw(294,129,295,129,3);
  183.     draw(296,126,296,128,3);draw(297,125,298,125,3);draw(299,126,299,128,3);
  184.     plot(298,129,3);draw(293,131,299,131,3);draw(293,132,293,135,3);
  185.     draw(296,132,296,134,3);draw(299,132,299,135,3);plot(294,141,3);
  186.     draw(293,138,293,140,3);draw(294,137,298,137,3);draw(299,138,299,140,3);
  187.     plot(298,141,3);
  188.   end;
  189.  
  190. procedure RetLossLabel;
  191.   begin Y := 22.222;
  192.     repeat draw(283,round(Y),295,round(Y),1); Y := Y + 22.222 until Y > 190;
  193.     I:=314;J:=19;Zero; I:=314;J:=41;Five; I:=309;J:=63;One; I:=314;Zero;
  194.     I:=309;J:=86;One; I:=314;Five; I:=308;J:=108;Two; I:=314;Zero;
  195.     I:=308;J:=130;Two; I:=314;Five; I:=308;J:=152;Three; I:=314;Zero;
  196.     I:=308;J:=175;Three; I:=314;Five;
  197.     for I := 291 to 299 do draw(I,67,I,140,0); {Clr Screen}
  198.     draw(292,61,298,61,3);draw(295,62,295,64,3);draw(294,63,292,65,3);
  199.     draw(296,65,297,65,3);draw(298,62,298,64,3);draw(292,67,298,67,3);
  200.     draw(292,68,292,71,3);draw(295,68,295,70,3);draw(298,68,298,71,3);
  201.     draw(298,73,298,77,3);draw(292,75,297,75,3);draw(293,79,298,79,3);
  202.     draw(292,80,292,82,3);draw(293,83,298,83,3);draw(292,85,298,85,3);
  203.     draw(295,86,295,88,3);draw(294,87,292,89,3);draw(296,89,297,89,3);
  204.     draw(298,86,298,88,3);draw(292,91,298,91,3);draw(298,91,292,95,3);
  205.     draw(292,95,298,95,3);draw(292,101,298,101,3);draw(292,102,292,105,3);
  206.     draw(293,107,297,107,3);draw(292,108,292,110,3);draw(298,108,298,110,3);
  207.     draw(293,111,297,111,3);draw(296,113,297,113,3);draw(298,114,298,116,3);
  208.     plot(297,117,3);draw(295,114,295,116,3);draw(293,117,294,117,3);
  209.     draw(292,114,292,116,3);plot(293,113,3);draw(296,119,297,119,3);
  210.     draw(298,120,298,122,3);plot(297,123,3);draw(295,120,295,122,3);
  211.     draw(293,123,294,123,3);draw(292,120,292,122,3);draw(292,129,298,129,3);
  212.     draw(292,130,292,132,3);draw(293,133,297,133,3);draw(298,130,298,132,3);
  213.     draw(292,135,298,135,3);draw(292,136,292,138,3);draw(293,139,294,139,3);
  214.     draw(295,136,295,138,3);draw(296,139,297,139,3);draw(298,136,298,138,3);
  215.   end;
  216.  
  217. procedure Numbers;
  218.   begin if K = 0 then Zero; if K = 1 then One; if K = 2 then Two;
  219.     if K = 3 then Three; if K = 4 then Four; if K = 5 then Five;
  220.     if K = 6 then Six; if K = 7 then Seven; if K = 8 then Eight;
  221.     if K = 9 then Nine
  222.   end;
  223.  
  224. procedure RealsForm;
  225.   begin if (TempR >= 1000) then str(TempR:4:0,TempS);
  226.     if (TempR < 1000) and (TempR >= 100) then str(TempR:4:1,TempS);
  227.     if (TempR < 100) and (TempR >= 10) then str(TempR:4:2,TempS);
  228.     if (TempR < 10) and (TempR >= 1) then str(TempR:4:3,TempS);
  229.     if (TempR < 1) and (TempR >= 0.1) then str(TempR:4:4,TempS);
  230.     if (TempR < 0.1) and (TempR >= 0.01) then str(TempR:4:5,TempS);
  231.     if (TempR < 0.01) and (TempR >= 0.001) then str(TempR:4:6,TempS);
  232.     if (TempR < 0.001) and (TempR >= 0.0001) then str(TempR:4:7,TempS);
  233.     if (TempR < 0.0001) and (TempR >= 0.00001) then str(TempR:4:8,TempS);
  234.     if (TempR < 0.00001) then str(TempR:4:9,TempS)
  235.   end;
  236.  
  237. procedure Units;
  238.   begin F7:=1E6; F7S:='MHz'; R7:=1; R7S:='ohm ';
  239.     C7:=1E-12; C7S:='pf  '; L7:=1E-6; L7S:='uh  '
  240.   end;
  241.  
  242. procedure UnitsAre;
  243.   begin writeln('   Units are:  ',F7S,'  ',R7S,'  ',C7S,'  ',L7S)
  244.   end;
  245.  
  246. procedure Node;
  247.   begin repeat gotoXY(Nx,whereY); write(Nodes[Nod,NC],' ');
  248.     gotoXY(Nx,whereY); read(Ch1); val(Ch1,TempI,Err);
  249.     if TempI > ND then Beep until TempI <= ND;
  250.     if Ch1 <> '' then Nodes[Nod,NC] := TempI;
  251.     gotoXY(Nx,whereY); write(Nodes[Nod,NC],' ')
  252.   end;
  253.  
  254. procedure Resistor;
  255.   begin Compo[NC] := 'R'; Comp := 'Res';
  256.     gotoXY(5,whereY); write(Comp); ClrEol;
  257.     TempR := Value[1,NC]/R7; RealsForm;
  258.     gotoXY(10,whereY); write(TempS,' ',R7S,'     ');
  259.     repeat gotoXY(10,whereY); read(TempS); val(TempS,TempR,Err);
  260.       if TempS <> '' then Value[1,NC] := TempR * R7;
  261.       TempR := Value[1,NC]/R7;
  262.     until TempR <> 0.0; RealsForm;
  263.     gotoXY(10,whereY); write(TempS,' ',R7S,'      ');
  264.     repeat
  265.       Nx := 40; Nod := 1; Node; Nx := 48; Nod := 2; Node;
  266.       if Nodes[1,NC] = Nodes[2,NC] then Beep
  267.     until Nodes[1,NC] <> Nodes[2,NC]
  268.   end;
  269.  
  270. procedure Capacitor;
  271.   begin Compo[NC] := 'C'; Comp := 'Cap';
  272.     gotoXY(5,whereY); write(Comp); ClrEol;
  273.     TempR := Value[1,NC]/C7; RealsForm;
  274.     gotoXY(10,whereY); write(TempS,' ',C7S,'     ');
  275.     repeat gotoXY(10,whereY); read(TempS); val(TempS,TempR,Err);
  276.       if TempS <> '' then Value[1,NC] := TempR * C7;
  277.       TempR := Value[1,NC]/C7;
  278.     until TempR <> 0.0; RealsForm;
  279.     gotoXY(10,whereY); write(TempS,' ',C7S,'      ');
  280.     repeat
  281.       Nx := 40; Nod := 1; Node; Nx := 48; Nod := 2; Node;
  282.       if Nodes[1,NC] = Nodes[2,NC] then Beep
  283.     until Nodes[1,NC] <> Nodes[2,NC]
  284.   end;
  285.  
  286. procedure Inductor;
  287.   begin Compo[NC] := 'I'; Comp := 'Ind';
  288.     gotoXY(5,whereY); write(Comp); ClrEol;
  289.     TempR := Value[1,NC]/L7; RealsForm;
  290.     gotoXY(10,whereY); write(TempS,' ',L7S,'     ');
  291.     repeat gotoXY(10,whereY); read(TempS); val(TempS,TempR,Err);
  292.       if TempS <> '' then Value[1,NC] := TempR * L7;
  293.       TempR := Value[1,NC]/L7;
  294.     until TempR <> 0.0; RealsForm;
  295.     gotoXY(10,whereY); write(TempS,' ',L7S,'      ');
  296.     repeat
  297.       Nx := 40; Nod := 1; Node; Nx := 48; Nod := 2; Node;
  298.       if Nodes[1,NC] = Nodes[2,NC] then Beep
  299.     until Nodes[1,NC] <> Nodes[2,NC]
  300.   end;
  301.  
  302. procedure OpAmp;
  303.   begin Compo[NC] := 'O'; Comp := 'OpA';
  304.     gotoXY(5,whereY); write(Comp); ClrEol;
  305.     TempR := Value[2,NC]; RealsForm;
  306.     gotoXY(10,whereY); write(TempS,' Gain(V)  ');
  307.     repeat gotoXY(10,whereY); read(TempS); val(TempS,TempR,Err);
  308.       if TempS <> '' then Value[2,NC] := TempR;
  309.       TempR := Value[2,NC];
  310.     until TempR <> 0.0; RealsForm;
  311.     gotoXY(10,whereY); write(TempS,' G(V)          ');
  312.     TempR := Value[1,NC]/R7; RealsForm;
  313.     gotoXY(25,whereY); write(TempS,' ',R7S,'Out     ');
  314.     repeat gotoXY(25,whereY); read(TempS); val(TempS,TempR,Err);
  315.       if TempS <> '' then Value[1,NC] := TempR * R7;
  316.       TempR := Value[1,NC]/R7;
  317.     until TempR <> 0.0; RealsForm;
  318.     gotoXY(25,whereY); write(TempS,' ',R7S,'O            ');
  319.     gotoXY(42,whereY); write('+In');
  320.     Nx := 40; Nod := 3; Node; write('+In  ');
  321.     gotoXY(50,whereY); write('-In');
  322.     Nx := 48; Nod := 4; Node; write('-In  ');
  323.     gotoXY(58,whereY); write('+Out');
  324.     Nx := 56; Nod := 2; Node; write('+Out  ');
  325.     gotoXY(66,whereY); write('-Out');
  326.     Nx := 64; Nod := 1; Node; write('-Out  ')
  327.   end;
  328.  
  329. procedure FET;
  330.   begin Compo[NC] := 'F'; Comp := 'FET';
  331.     gotoXY(5,whereY); write(Comp); ClrEol;
  332.     TempR := Value[1,NC]; RealsForm;
  333.     gotoXY(10,whereY); write(TempS,' Gain(A/V)   ');
  334.     repeat gotoXY(10,whereY); read(TempS); val(TempS,TempR,Err);
  335.       if TempS <> '' then Value[1,NC] := TempR;
  336.       TempR := Value[1,NC];
  337.     until TempR <> 0.0; RealsForm;
  338.     gotoXY(10,whereY); write(TempS,' Gain(A/V)       ');
  339.     repeat gotoXY(42,whereY); write('S');
  340.       Nx := 40; Nod := 2; Node; write('S  ');
  341.       gotoXY(50,whereY); write('G');
  342.       Nx := 48; Nod := 3; Node; write('G  ');
  343.       gotoXY(58,whereY); write('D');
  344.       Nx := 56; Nod := 1; Node; write('D  ');
  345.       if Nodes[1,NC] = Nodes[2,NC] then Beep;
  346.       if Nodes[2,NC] = Nodes[3,NC] then Beep;
  347.       if Nodes[3,NC] = Nodes[1,NC] then Beep
  348.     until (Nodes[1,NC] <> Nodes[2,NC]) and (Nodes[2,NC] <> Nodes[3,NC]) and
  349.           (Nodes[3,NC] <> Nodes[1,NC])
  350.     end;
  351.  
  352. procedure BiPolarT;
  353.   begin Compo[NC] := 'B'; Comp := 'BPT';
  354.     gotoXY(5,whereY); write(Comp); ClrEol;
  355.     TempR := Value[2,NC]; RealsForm;
  356.     gotoXY(10,whereY); write(TempS,' Beta    ');
  357.     repeat gotoXY(10,whereY); read(TempS); val(TempS,TempR,Err);
  358.       if TempS <> '' then Value[2,NC] := TempR;
  359.       TempR := Value[2,NC];
  360.     until TempR <> 0.0;  RealsForm;
  361.     gotoXY(10,whereY); write(TempS,' B           ');
  362.     TempR := Value[1,NC]/R7; RealsForm;
  363.     gotoXY(23,whereY); write(TempS,' ',R7S,'B/E  ');
  364.     repeat gotoXY(23,whereY); read(TempS); val(TempS,TempR,Err);
  365.       if TempS <> '' then Value[1,NC] := TempR * R7;
  366.       TempR := Value[1,NC]/R7;
  367.     until TempR <> 0.0; RealsForm;
  368.     gotoXY(23,whereY); write(TempS,' ',R7S,'B/E      ');
  369.     repeat gotoXY(42,whereY); write('E');
  370.       Nx := 40; Nod := 2; Node; write('E  ');
  371.       gotoXY(50,whereY); write('B');
  372.       Nx := 48; Nod := 3; Node; write('B  ');
  373.       gotoXY(58,whereY); write('C');
  374.       Nx := 56; Nod := 1; Node; write('C  ');
  375.       if Nodes[1,NC] = Nodes[2,NC] then Beep;
  376.       if Nodes[2,NC] = Nodes[3,NC] then Beep;
  377.       if Nodes[3,NC] = Nodes[1,NC] then Beep
  378.     until (Nodes[1,NC] <> Nodes[2,NC]) and (Nodes[2,NC] <> Nodes[3,NC]) and
  379.           (Nodes[3,NC] <> Nodes[1,NC])
  380.   end;
  381.  
  382. procedure Line;
  383.   begin Compo[NC] := 'L'; Comp := 'Line';
  384.     gotoXY(5,whereY); write(Comp); ClrEol;
  385.     TempR := Value[2,NC]/F7; RealsForm;
  386.     gotoXY(10,whereY); write(TempS,' ',F7S,'L/4  ');
  387.     repeat gotoXY(10,whereY); read(TempS); val(TempS,TempR,Err);
  388.       if TempS <> '' then Value[2,NC] := TempR*F7;
  389.       TempR := Value[2,NC]/F7;
  390.     until TempR <> 0.0; RealsForm;
  391.     gotoXY(10,whereY); write(TempS,' ',F7S,'L/4       ');
  392.     TempR := Value[1,NC]/R7; RealsForm;
  393.     gotoXY(27,whereY); write(TempS,' ',R7S,'     ');
  394.     repeat gotoXY(27,whereY); read(TempS); val(TempS,TempR,Err);
  395.       if TempS <> '' then Value[1,NC] := TempR * R7;
  396.       TempR := Value[1,NC]/R7;
  397.     until TempR <> 0.0; RealsForm;
  398.     gotoXY(27,whereY); write(TempS,' ',R7S,'         ');
  399.     gotoXY(42,whereY); write('Lin');
  400.     Nx := 40; Nod := 3; Node; write('Lin  ');
  401.     gotoXY(50,whereY); write('Gin');
  402.     Nx := 48; Nod := 4; Node; write('Gin  ');
  403.     gotoXY(58,whereY); write('Lout');
  404.     Nx := 56; Nod := 2; Node; write('Lout  ');
  405.     gotoXY(66,whereY); write('Gout');
  406.     Nx := 64; Nod := 1; Node; write('Gout  ')
  407.   end;
  408.  
  409. procedure ClearData;
  410.   begin for I := 1 to NoC do
  411.     begin  Compo[I] := ''; for J := 1 to 4 do begin Nodes[J,I] := 0 end;
  412.       for J := 1 to 2 do begin Value[J,I] := 0 end
  413.     end
  414.   end;
  415.  
  416. procedure ClearDeter;
  417.   begin for I := 1 to NoN do for J := 1 to NoN do
  418.     begin A[I,J] := 0.0; B[I,J] := 0.0; B1[I,J] := 0.0; P[I,J] := 0.0;
  419.       Q[I,J] := 0.0; Q1[I,J] := 0.0; S[I,J] := 0.0
  420.     end
  421.   end;
  422.  
  423. procedure Determinant;
  424.   begin N1:=N; N:=N-1; I:=0; for K := 1 to N do
  425.     begin if K = D1 then I := 1; J := 0;
  426.       for L := 1 to N do
  427.       begin if L = D2 then J := 1; A[K,L] := P[K+I,L+J];
  428.         B[K,L] := W*Q[K+I,L+J]+Q1[K+I,L+J]/W+S[K+I,L+J]
  429.       end
  430.     end;
  431.     if N <= 1 then
  432.     begin D1 := A[N,N]; D2 := B[N,N]
  433.     end
  434.     else
  435.     begin D1 := 1.0; D2 := 0.0; K := 1;
  436.       repeat  L := K; S2 := abs(A[K,K]) + abs(B[K,K]);
  437.         for I := K to N do
  438.         begin T := abs(A[I,K]) + abs(B[I,K]);
  439.           if S2 < T then begin L := I; S2 := T end
  440.         end;
  441.         if L <> K then
  442.         begin for J := 1 to N do
  443.           begin S2 := -A[K,J]; A[K,J] := A[L,J]; A[L,J] := S2;
  444.             S1 := -B[K,J]; B[K,J] := B[L,J]; B[L,J] := S1
  445.           end
  446.         end;
  447.         L := K + 1; for I := L to N do
  448.         begin S1 := A[K,K] * A[K,K] + B[K,K] * B[K,K];
  449.           S2 := (A[I,K] * A[K,K] + B[I,K] * B[K,K]) / S1;
  450.           B[I,K] := (A[K,K] * B[I,K] - A[I,K] * B[K,K]) / S1;
  451.           A[I,K] := S2
  452.         end;
  453.         J2 := K - 1; if J2 <> 0 then
  454.         begin for J := L to N do
  455.           begin for I := 1 to J2 do
  456.             begin A[K,J] := A[K,J] - A[K,I] * A[I,J] + B[K,I] * B[I,J];
  457.               B[K,J] := B[K,J] - B[K,I] * A[I,J] - A[K,I] * B[I,J]
  458.             end
  459.           end
  460.         end;
  461.         J2 := K; K := K + 1; for I := K to N do
  462.         begin for J := 1 to J2 do
  463.           begin A[I,K] := A[I,K] - A[I,J] * A[J,K] + B[I,J] * B[J,K];
  464.             B[I,K] := B[I,K] - B[I,J] * A[J,K] - A[I,J] * B[J,K]
  465.           end
  466.         end
  467.       until K = N;
  468.       L := 1; J2 := trunc(N/2);
  469.       if N <> 2 * J2 then begin L := 0; D1 := A[N,N]; D2 := B[N,N] end;
  470.       for I := 1 to J2 do
  471.       begin J := N - I + L; S2 := A[I,I] * A[J,J] - B[I,I] * B[J,J];
  472.         S1 := A[I,I] * B[J,J] + A[J,J] * B[I,I]; T := D1 * S2 - D2 * S1;
  473.         D2 := D2 * S2 + D1 * S1; D1 := T
  474.       end;
  475.       N := N1; if ((D1<1E-16) and (D1> -1E-16)) or ((D2<1E-16) and
  476.       (D2> -1E-16)) then B2 := sqrt(sqr(D1*1E16) + sqr(D2*1E16)) / 1E16
  477.       else B2 := sqrt(sqr(D1) + sqr(D2));
  478.       if D1 = 0.0 then
  479.       begin if D2 <> 0.0 then
  480.         begin if D2 > 0.0 then D2 := 90
  481.           else D2 := - 90
  482.         end
  483.       end
  484.       else
  485.       begin if D1 >= 0.0 then Q2 := 0.0 else Q2 := 180;
  486.         if D2 < 0.0 then Q2 := - Q2; D2 := Q2 + 180 * arctan(D2/D1)/pi
  487.       end
  488.     end
  489.   end;
  490.  
  491. procedure CheckArray;
  492.   begin if I > N then N := I; if J > N then N := J
  493.   end;
  494.  
  495. procedure LoadArrayR;
  496.   begin if I = 0 then A[J,J] := A[J,J] + V else
  497.     begin A[I,I] := A[I,I] + V; if J <> 0 then
  498.       begin A[I,J] := A[I,J] - V; A[J,I] := A[J,I] - V;
  499.         A[J,J] := A[J,J] + V
  500.       end
  501.     end;
  502.     CheckArray
  503.   end;
  504.  
  505. procedure LoadArrayC;
  506.   begin if I = 0 then B[J,J] := B[J,J] + V else
  507.     begin B[I,I] := B[I,I] + V; if J <> 0 then
  508.       begin B[I,J] := B[I,J] - V; B[J,I] := B[J,I] - V;
  509.         B[J,J] := B[J,J] + V
  510.       end
  511.     end;
  512.     CheckArray
  513.   end;
  514.  
  515. procedure LoadArrayI;
  516.   begin if I = 0 then B1[J,J] := B1[J,J] + V else
  517.     begin B1[I,I] := B1[I,I] + V; if J <> 0 then
  518.       begin B1[I,J] := B1[I,J] - V; B1[J,I] := B1[J,I] - V;
  519.         B1[J,J] := B1[J,J] + V
  520.       end
  521.     end;
  522.     CheckArray
  523.   end;
  524.  
  525. procedure LoadArrayOB;
  526.   begin if (I <> 0) and (K <> 0) then A[I,K] := A[I,K] + V;
  527.     if (J <> 0) and (L <> 0) then A[J,L] := A[J,L] + V;
  528.     if (J <> 0) and (K <> 0) then A[J,K] := A[J,K] - V;
  529.     if (I <> 0) and (L <> 0) then A[I,L] := A[I,L] - V;
  530.     if K > N then N := K;
  531.     if L > N then N := L
  532.   end;
  533.  
  534. procedure LoadArraySubLine;
  535.   begin S[QL,QL] := S[QL,QL] + RR; S[RL,RL] := S[RL,RL] + RR;
  536.     S[QL,RL] := S[QL,RL] - RR; S[RL,QL] := S[RL,QL] - RR
  537.   end;
  538.  
  539. procedure LoadArrayLine;
  540.   begin for R1 := 1 to N do
  541.     begin for R2 := 1 to N do begin S[R1,R2] := 0 end end;
  542.     for X1 := 1 to NC do
  543.     begin if Compo[X1] = 'L' then
  544.       begin RR := -1/(Value[1,X1]*sin(0.25*W/Value[2,X1])/
  545.         cos(0.25*W/Value[2,X1]));
  546.         QL := Nodes[4,X1]; RL := Nodes[3,X1]; LoadArraySubLine;
  547.         QL := Nodes[1,X1]; RL := Nodes[2,X1]; LoadArraysubLine;
  548.         RR := 1 / (Value[1,X1] * sin(0.25 * W / Value[2,X1]));
  549.         PL := Nodes[3,X1]; RL := Nodes[1,X1];
  550.         S[RL,PL] := S[RL,PL]-RR; S[PL,RL] := S[PL,RL]-RR; RL := Nodes[2,X1];
  551.         S[RL,PL] := S[RL,PL]+RR; S[PL,RL] := S[PL,RL]+RR; PL := Nodes[4,X1];
  552.         S[RL,PL] := S[RL,PL]-RR; S[PL,RL] := S[PL,RL]-RR; RL := Nodes[1,X1];
  553.         S[RL,PL] := S[RL,PL]+RR; S[PL,RL] := S[PL,RL]+RR
  554.       end
  555.     end
  556.   end;
  557.  
  558. procedure TestForLine;
  559.   begin for X1 := 1 to NC do begin if Compo[X1] = 'L' then FLGL := true end
  560.   end;
  561.  
  562. procedure LoadArray;
  563.   begin ClearDeter;
  564.     for M := 1 to NC do
  565.     begin V := Value[1,M]; B2 := Value[2,M]; I := Nodes[1,M];
  566.       J := Nodes[2,M]; K := Nodes[3,M]; L := Nodes[4,M];
  567.       if V <> 0 then
  568.       begin if Compo[M] = 'R' then begin V := 1 / V; LoadArrayR end;
  569.         if Compo[M] = 'C' then LoadArrayC;
  570.         if Compo[M] = 'I' then begin V := -1 / V; LoadArrayI end;
  571.         if Compo[M] = 'O' then begin V := 1 / V;
  572.            LoadArrayR; V := B2 * V; LoadArrayOB end;
  573.         if Compo[M] = 'F' then begin L := J; LoadArrayOB end;
  574.         if Compo[M] = 'B' then begin L := I; I := K; V := 1 / V;
  575.            LoadArrayR; I := L; L := J; V := B2 * V; LoadArrayOB end
  576.       end
  577.     end;
  578.     for I := 0 to N do for J := 0 to N do
  579.     begin P[I,J] := A[I,J]; Q1[I,J] := B1[I,J]; Q[I,J] := B[I,J] end
  580.   end;
  581.  
  582. procedure SweepStart;
  583.   begin gotoXY(5,4); writeln('The Name of Circuit is ',CirName);
  584.     gotoXY(10,6); writeln('Graph Amplitude');
  585.     gotoXY(10,7); writeln('Graph Phase ? ',PS);
  586.     gotoXY(24,7); read(kbd,Chm);
  587.     if (Chm='Y') or (Chm='y') then PS := 'Y';
  588.     if (Chm='N') or (Chm='n') then PS := 'N';
  589.     gotoXY(24,7); writeln(PS);
  590.     gotoXY(10,8); writeln('Graph Time Delay ? ',TM);
  591.     gotoXY(29,8); read(kbd,Chm);
  592.     if (Chm='Y') or (Chm='y') then TM := 'Y';
  593.     if (Chm='N') or (Chm='n') then TM := 'N';
  594.     gotoXY(29,8); writeln(TM);
  595.     gotoXY(10,9); writeln('Graph Return Loss ? ',RLOS);
  596.     gotoXY(30,9); read(kbd,Chm);
  597.     if (Chm='Y') or (Chm='y') then RLOS := 'Y';
  598.     if (Chm='N') or (Chm='n') then RLOS := 'N';
  599.     gotoXY(30,9); writeln(RLOS)
  600.   end;
  601.  
  602. procedure NoGraph;
  603.   begin Last[1,1] := 300; Ref[1,1] := 300
  604.   end;
  605.  
  606. procedure FreqLimits;
  607.   begin repeat repeat TempR := F1/F7;
  608.         gotoXY(1,10); write('Start Frequency = ',TempR:14:6,' ',F7S);
  609.         gotoXY(19,10); read(TempS); Val(TempS,TempR,Err);
  610.         if TempS <> '' then begin F1 := TempR * F7; NoGraph end;
  611.         TempR := F1/F7; gotoXY(19,10); writeln(TempR:14:6,' ',F7S,'      ');
  612.         if F1 <= 0 then Beep
  613.       until F1 > 0;
  614.       repeat TempR := F2/F7;
  615.         gotoXY(1,11); write('Stop Frequency  = ',TempR:14:6,' ',F7S);
  616.         gotoXY(19,11); read(TempS); Val(TempS,TempR,Err);
  617.         if TempS <> '' then begin F2 := TempR * F7; NoGraph end;
  618.         TempR := F2/F7; gotoXY(19,11); writeln(TempR:14:6,' ',F7S,'      ');
  619.         if F2 <= 0 then Beep
  620.       until F2 > 0; if F1 >= F2 then Beep
  621.     until F1 < F2;
  622.     repeat gotoXY(1,12);
  623.       if FLGA then TempS := 'A' else str(F3,TempS);
  624.       write('No of Steps     = ',TempS,'     A for Automatic');
  625.       FLGB := false;
  626.       repeat gotoXY(19,12); read(TempS); Val(TempS,TempI,Err);
  627.         if (TempI>0) and (TempS<>'') then begin Val(TempS,F3,Err);
  628.                 FLGA := false; FLGB := true end;
  629.         if (TempS = 'A') or (TempS = 'a') then begin
  630.                 TempS := 'A'; F3 := 50; FLGA := true; FLGB := true end;
  631.         if (TempS='') and (FLGA) then begin TempS := 'A';
  632.                 F3 := 50; FLGB := true end;
  633.         if (TempS='') and (not FLGA) then begin str(F3,TempS);
  634.                 FLGB := true end;
  635.       until FLGB;
  636.       gotoXY(19,12); writeln(TempS,'                       ');
  637.       if F3 < 1 then Beep
  638.     until F3 > 0
  639.   end;
  640.  
  641. procedure GainLimits;
  642.   begin repeat gotoXY(1,13); write('Maximum Level   = ',trunc(Y1),' dB');
  643.     gotoXY(19,13); read(TempS); Val(TempS,TempI,Err);
  644.     if TempS <>'' then begin Y1 := TempI; NoGraph end;
  645.     gotoXY(19,13); writeln(trunc(Y1),' dB      ');
  646.     gotoXY(1,14); write('Minimum Level   = ',trunc(Y2),' dB');
  647.     gotoXY(19,14); read(TempS); Val(TempS,TempI,Err);
  648.     if TempS <>'' then begin Y2 := TempI; NoGraph end;
  649.     gotoXY(19,14); writeln(trunc(Y2),' dB      ');
  650.     if Y1 <= Y2 then Beep
  651.     until Y1 > Y2
  652.   end;
  653.  
  654. procedure TimeLimits;
  655.   begin      {repeat TempR := T1;
  656.     gotoXY(1,15); write('Maximum Time    = ',TempR:14:6,' uSec');
  657.     gotoXY(19,15); read(TempS); Val(TempS,TempR,Err);
  658.     if TempS <>'' then begin T1 := TempR; NoGraph end;
  659.     TempR := T1; gotoXY(19,15); writeln(TempR:14:6,' uSec      ');
  660.     TempR := T2;
  661.     gotoXY(1,16); write('Minimum Time    = ',TempR:14:6,' uSec');
  662.     gotoXY(19,16); read(TempS); Val(TempS,TempR,Err);
  663.     if TempS <>'' then begin T2 := TempR; NoGraph end;
  664.     TempR := T2; gotoXY(19,16); writeln(TempR:14:6,' uSec      ');
  665.     if T1 <= T2 then Beep
  666.     until T1 > T2      }
  667.   end;
  668.  
  669. procedure LinearFreqGrid;
  670.   begin G6 := 0; G7 := 0; G8 := 3; if F2/F1 < 1.06 then G8 := 4;
  671.     G2 := ln((F2-F1)/3)/ln(10);
  672.     G3 := exp(int(G2)*ln(10))/2*exp(int((G2-int(G2))/0.34)*ln(2));
  673.     G4 := int(F1 / G3) * G3;
  674.     X := 319 * ((int(F1/G3)+1)*G3-F1) / (F2-F1);
  675.     repeat Y := 10;
  676.       repeat draw(round(X), trunc(Y), round(X), trunc(Y+3), 1);
  677.         Y := Y + 22.222
  678.       until Y > 172; G4 := G4 + G3;
  679.       if (X > 16) and (X < 298) then
  680.       begin if (G4>0) and (G7>0) then
  681.         begin if trunc(ln(G4)/ln(10)) > trunc(ln(G7)/ln(10)) then G6 := 1
  682.         end;
  683.         Y := 1;
  684.         repeat str(G4:0:0,TempS); val(copy(TempS,trunc(Y+G6),1),G5,Err);
  685.           I := round(X) -15 + round(Y) * 6; J := 190; K := round(G5);
  686.           Numbers; Y := Y + 1
  687.         until Y > G8; G7 := G4
  688.       end;
  689.       X := X + 319 * G3 / (F2 - F1)
  690.     until X > 319
  691.   end;
  692.  
  693. procedure LogFreqGrid;
  694.   begin G2 := 1; G4 := ln(F1) - int(ln(F1)/ln(10)) * ln(10);
  695.     L := trunc(ln(F1*1.000000001)/ln(10));
  696.     repeat G3 := 0;
  697.       repeat G3 := G3 + 1;
  698.         X := 319 * (ln(G2*G3) - G4) / ln(F2/F1); Y := 10;
  699.         repeat draw(round(X), trunc(Y), round(x), trunc(Y+3), 1);
  700.           Y := Y + 22.222
  701.         until Y > 172; if (X > 5) and (X < 315) then
  702.         begin if(F2/F1< 2000) or (G3<6) then
  703.           begin I := round(X); J := 190; K := round(G3); if K = 1 then
  704.               begin J := 187; L := L + 1; K := L;
  705.                 if K = 3 then KKK; if K = 6 then MMM; if K = 9 then GGG;
  706.                 if (K<>3) and (K<>6) and (K<>9) then Numbers
  707.               end
  708.             else Numbers
  709.           end
  710.         end
  711.       until G3 > 9; G2 := G2 * 10
  712.     until X > 309
  713.   end;
  714.  
  715. procedure GainGrid;
  716.   begin Y3 := 20; if Y1-Y2 <= 80 then Y3 := 10;
  717.     if Y1-Y2 <= 40 then Y3 := 5; if Y1-Y2 <= 20 then Y3 := 2;
  718.     if Y1-Y2 <= 10 then Y3 := 1; Y0 := 0;
  719.     while Y0 < -Y1 do Y0 := Y0 + Y3;
  720.     while Y0 > -Y1 do Y0 := Y0 - Y3;
  721.     Y4 := 0; while Y4 > Y1 - Y3 do Y4 := Y4 - Y3;
  722.     while Y4 < Y1 - Y3 do Y4 := Y4 + Y3; Y4 := -Y4;
  723.     Y := 200 * (Y3 + Y1 + Y0) / (Y1 - Y2);
  724.     repeat if (Y>5) and (Y<190) then
  725.       begin draw(18,round(Y),295,round(Y),1);
  726.         Y5 := trunc(abs(Y4)/10); if Y5 > 0 then
  727.         begin if Y5 > 10 then Y5 := Y5 - 10;
  728.           I := 5; J := round(Y-3); K := Y5; Numbers
  729.         end;
  730.         Y6 := abs(Y4) - 10 * Y5;
  731.         if Y6 >= 100 then Y6 := trunc(Y6 / 10);
  732.         I := 11; J := round(Y-3); K :=Y6; Numbers
  733.       end;
  734.       Y4 := Y4 + Y3; Y := Y + 200 * Y3 / (Y1 - Y2)
  735.     until Y > 199
  736.   end;
  737.  
  738. procedure ScreenPrint;
  739.   begin TempR := F/F7; write(TempR); gotoXY(28,whereY);
  740.     TempR := GA; RealsForm; write(TempS); gotoXY(44,whereY);
  741.     TempR := TH; RealsForm; writeln(TempS)
  742.   end;
  743.  
  744. procedure PrinterPrint;
  745.   begin TempR := F/F7; write(lst,TempR,'      ');
  746.     TempR := GA; RealsForm; write(lst,TempS,'      ');
  747.     TempR := TH; RealsForm; writeln(lst,TempS)
  748.   end;
  749.  
  750. procedure SweepLoop
  751. ;
  752.   begin F := F1; LA := 0.0; LR := 0.0; LT := 0.0; LM := 0.0; LX := 0.0;
  753.     LRET := 0.0; X := 0.0; D := 1; F4 := F3; TestForLine;
  754.     repeat W := 2 * pi * F;
  755.       if RLOS = 'Y' then
  756.       begin D1 := NI; D2 := 2;
  757.         if FLGL then LoadArrayLine; Determinant; V := B2; TH := D2;
  758.         if frac((NI+NO)/2) > 0 then TH := TH - 180;
  759.         D1 := NI; D2 := NI; Determinant;
  760.         THRET := TH - D2; VRET := V / B2;
  761.         if VRET <> 0.0 then
  762.         begin if VRET < 0.49999 then GRET := VRET * 2.0
  763.             else if VRET > 0.50001 then GRET := (1-VRET) * 2.0
  764.               else GRET := 0.99998;
  765.           GRET := abs(GRET * sqr(sqr(cos(THRET * PI / 180))));
  766.           GRET := 22 - 4.45 * (ln(1 - GRET) * 20 / ln(10));
  767.           draw(round(LX),round(LRET),round(X),round(GRET),3);
  768.         end; LRET:=GRET;
  769.       end;
  770.       D1 := NI; D2 := NO;
  771.       if FLGL then LoadArrayLine; Determinant; V := B2; TH := D2;
  772.       if frac((NI+NO)/2) > 0 then TH := TH - 180;
  773.       D1 := NI; D2 := NI; Determinant;
  774.       TH := TH - D2; Sound(1000); Delay(1); NoSound; V := V / B2;
  775.       if V <> 0.0 then
  776.       begin draw(round(LX),199,round(X),199,1); GA := ln(V)* 20/ln(10);
  777.         if (D>1) and (TM='Y') then begin TT := (TL-TH)/(F-FL)/360;
  778.           if TT>1E-20 then MM := (ln(T1*1E-6)-ln(TT))*200/ln(T1/T2); end;
  779.         FL := F; TL := TH;
  780.         if FLG = 0 then
  781.         begin GA := 199 * (Y1 - GA) / (Y1 - Y2);
  782.           draw(round(LX), round(LA), round(X), round(GA), 2);
  783.           while TH > 0.0 do begin TH := TH - 360 end;
  784.           while TH < -360 do begin TH := TH + 360 end;
  785.           TH := -200 * TH / 405 + 22; if TH > 199 then TH := TH - 200;
  786.           if PS = 'Y' then
  787.              draw(round(LX), round(LT), round(X), round(TH), 1);
  788.           if (D>2) and (TM='Y') then
  789.              draw(round(LX), round(ML), round(X), round(MM), 3);
  790.         end;
  791.         Last[1,D] := X; Last[2,D] := GA; Last[3,D] := TH;
  792.         Last[4,D] := MM; Last[5,D] := GRET;
  793.         if FLGA then
  794.         begin if ((abs(GA-LA)>5) or (abs(TH-LT)>5)) and (F4<500)
  795.             then F4:=F4*2; if ((abs(GA-LA)<2) or (GA>202)) and (X<300)
  796.             and (abs(TH-LT)<2) and (F4>20) then F4 := round(F4/2)
  797.         end;
  798.         LA := GA; LT := TH; LM := 0.0; LX := X; ML := MM; D := D + 1;
  799.         if D > 300 then D := 300;
  800.         if KeyPressed then
  801.         begin read(kbd,Ch);
  802.           case Ch of
  803.             'T','t' : begin F4 := round(F4/2); FLGA := false; end;
  804.             'H','h' : begin F4 := F4*2; FLGA := false; end;
  805.             'P','p' : PS:='Y';
  806.             'R','r' : RLOS := 'Y';
  807.             'O','o' : begin PS:='N'; RLOS := 'N'; end;
  808.             'A','a' : FLGA := true;
  809.             #27 : F:=F2*2
  810.           end
  811.         end;
  812.         if FLG = 1 then ScreenPrint;
  813.         if FLG = 2 then PrinterPrint;
  814.         X := X + 319 / F4;
  815.         if F2/F1 < 3 then F := F + (F2-F1) / F4
  816.           else F := F * exp(1 / F4 * ln(F2 / F1));
  817.       end
  818.       else
  819.       begin TextMode(C80); Beep; Delay(200);Beep; Delay(200); Beep;
  820.         gotoXY(15,10); writeln('Error in Input Data'); F := F2 * 2
  821.       end
  822.     until F > F2 + 2*(F2-F1)/F4;
  823.   Last[1,D] := 300; Beep; FLGL := false
  824.   end;
  825.  
  826. procedure ChangeUnits;
  827.   begin repeat clrscr; writeln('Current Units are'); writeln;
  828.     writeln('1   ',F7S); writeln('2   ',R7S);
  829.     writeln('3   ',C7S); writeln('4   ',L7S);
  830.     writeln('5   Normal Units   (MHz  ohm  pf  uh)'); read(kbd,Ch);
  831.     case CH of
  832.       '1' : begin if F7 = 1E9 then begin F7:=1; F7S:=' Hz' end else
  833.               begin if F7 = 1E6 then begin F7:=1E9; F7S:='GHz' end;
  834.               if F7 = 1E3 then begin F7:=1E6; F7S:='MHz' end;
  835.               if F7 = 1   then begin F7:=1E3; F7S:='kHz' end end
  836.             end;
  837.       '2' : begin if R7 = 1E6 then begin R7:=1; R7S:='ohm ' end else
  838.               begin if R7 = 1E3 then begin R7:=1E6; R7S:='Mohm' end;
  839.               if R7 = 1 then begin R7:=1E3; R7S:='kohm' end end
  840.             end;
  841.       '3' : begin if C7 = 1E-12 then begin C7:=1E-6; C7S:='uf  ' end else
  842.               begin if C7 = 1E-9 then begin C7:=1E-12; C7S:='pf  ' end;
  843.               if C7 = 1E-6 then begin C7:=1E-9; C7S:='nf  ' end end
  844.             end;
  845.       '4' : begin if L7 = 1 then begin L7:=1E-3; L7S:='mh  ' end else
  846.               begin if L7 = 1E-9 then begin L7:=1; L7S:='hy  ' end;
  847.               if L7 = 1E-6 then begin L7:=1E-9; L7S:='nh  ' end;
  848.               if L7 = 1E-3 then begin L7:=1E-6; L7S:='uh  ' end end
  849.             end;
  850.       '5' : Units
  851.     end;
  852.     until (Ch=#13) or (Ch=#32)
  853.   end;
  854.  
  855. procedure EnterData;
  856.   begin clrscr; writeln('          Name of Circut is ',CirName); writeln;
  857.     writeln; writeln('E to Exit'); write('Use 8 or less characters,');
  858.     writeln('   with no spaces,  the first being a letter');
  859.     gotoXY(29,1); read(TempS); Ch := 'X';
  860.     while (TempS<>'E') and (TempS<>'e') and (Ch<>#13) do
  861.       begin if TempS <> '' then CirName := TempS;
  862.         ClearData; I:=0; J:=0; K:=0; L:=0; N:=0; NC:=0; NoGraph;
  863.         repeat repeat repeat
  864.           clrscr; writeln('          Name of Circut is ',CirName); writeln;
  865.           UnitsAre; ND:=0; NI:=0; NO:=0;
  866.           writeln; writeln('No of Nodes = ');
  867.           gotoXY(15,5); read(Ch1); val(Ch1,ND,Err);
  868.           if (ND>NoN) or (ND<3) then Beep
  869.         until (ND<=NoN) and (ND>2);
  870.           gotoXY(22,5); write('Input = ');
  871.           read(Ch1); val(Ch1,NI,Err);
  872.           if (NI=0) or (NI>ND) then Beep
  873.         until (NI>0) and (NI<=ND);
  874.           gotoXY(36,5); write('Output = ');
  875.           readln(Ch1); val(Ch1,NO,Err);
  876.           if (NO=0) or (NO>ND) then Beep
  877.         until (NO>0) and (NO<=ND);
  878.         write('  Comp    Value                       Nodes---');
  879.         repeat writeln; NC := NC + 1; gotoXY(1,whereY);
  880.           write(NC,'    R/C/I/O/F/B/L'); gotoXY(5,whereY); read(kbd,Ch);
  881.           case Ch of
  882.             'R','r' : Resistor;
  883.             'C','c' : Capacitor;
  884.             'I','i' : Inductor;
  885.             'O','o' : OpAmp;
  886.             'F','f' : FET;
  887.             'B','b' : BiPolarT;
  888.             'L','l' : Line;
  889.             #13 : begin end
  890.             else begin Beep; NC := NC - 1; gotoXY(5,whereY-1); end
  891.           end
  892.         until Ch = #13
  893.       end; NC := NC - 1
  894.   end;
  895.  
  896. procedure ScreenL;
  897.   begin if I < 10 then write(I,'   ') else write(I,'  ');
  898.     case Compo[I] of
  899.       'R' : begin write('Res     '); TempR := Value[1,I]/R7; RealsForm;
  900.           write(TempS,' ',R7S,'                 ');
  901.           write(Nodes[1,I],'       ',Nodes[2,I]) end;
  902.       'C' : begin write('Cap     '); TempR := Value[1,I]/C7; RealsForm;
  903.           write(TempS,' ',C7S,'                 ');
  904.           write(Nodes[1,I],'       ',Nodes[2,I]) end;
  905.       'I' : begin write('Ind     '); TempR := Value[1,I]/L7; RealsForm;
  906.           write(TempS,' ',L7S,'                 ');
  907.           write(Nodes[1,I],'       ',Nodes[2,I]) end;
  908.       'O' : begin write('OpA     ');
  909.           TempR := Value[2,I]; RealsForm; write(TempS,' G(V)     ');
  910.           TempR := Value[1,I]/R7; RealsForm; write(TempS,' ',R7S,'O  ');
  911.           write(Nodes[3,I],' +In   ',Nodes[4,I],' -In   '
  912.               ,Nodes[2,I],' +Out  ',Nodes[1,I],' -Out   ') end;
  913.       'F' : begin write('FET     '); TempR := Value[1,I]; RealsForm;
  914.           write(TempS,' Gain(A/V)            ');
  915.           write(Nodes[2,I],' S     ',Nodes[3,I],' G     '
  916.               ,Nodes[1,I],' D      ') end;
  917.       'B' : begin write('BiPolar '); TempR := Value[2,I]; RealsForm;
  918.           write(TempS,' Beta '); TempR := Value[1,I]/R7; RealsForm;
  919.           write(TempS,' ',R7S,' B/E   ');
  920.           write(Nodes[2,I],' E     ',Nodes[3,I],' B     '
  921.               ,Nodes[1,I],' C     ') end;
  922.       'L' : begin write('Line    '); TempR := Value[2,I]/F7; realsForm;
  923.           write(TempS,' ',F7S,' L/4   ');
  924.           TempR := Value[1,I]/R7; RealsForm; write(TempS,' ',R7S,' ');
  925.           write(Nodes[3,I],' Lin   ',Nodes[4,I],' Gin   '
  926.               ,Nodes[2,I],' Lout  ',Nodes[1,I],' Gout   ') end
  927.     end;
  928.     writeln
  929.   end;
  930.  
  931. procedure ScreenList;
  932.   begin clrscr;
  933.     writeln('          Name of Circut is ',CirName); writeln; UnitsAre;
  934.     writeln('   No of Nodes = ',ND,'   Input = ',NI,'   Output = ',NO);
  935.     writeln('    Comp    Value                       Nodes---');
  936.     for I := 1 to NC do
  937.     begin if I = 20 then read(kbd,Chm); ScreenL end;
  938.   read(kbd,Chm)
  939.   end;
  940.  
  941. procedure PrinterList;
  942.   begin writeln(lst,'          Name of Circut is ',CirName);
  943.     writeln(lst,'   Units are:  ',F7S,'  ',R7S,'  ',C7S,'  ',L7S);
  944.     writeln(lst,'   No of Nodes = ',ND,'   Input = ',NI,'   Output = ',NO);
  945.     writeln(lst,'    Comp    Value                       Nodes---');
  946.     for I := 1 to NC do
  947.     begin if I < 10 then write(lst,I,'   ') else write(lst,I,'  ');
  948.       case Compo[I] of
  949.       'R' : begin write(lst,'Res     '); TempR := Value[1,I]/R7; RealsForm;
  950.            write(lst,TempS,' ',R7S,'                 ');
  951.            write(lst,Nodes[1,I],'       ',Nodes[2,I]) end;
  952.       'C' : begin write(lst,'Cap     '); TempR := Value[1,I]/C7; RealsForm;
  953.           write(lst,TempS,' ',C7S,'                 ');
  954.           write(lst,Nodes[1,I],'       ',Nodes[2,I]) end;
  955.       'I' : begin write(lst,'Ind     '); TempR := Value[1,I]/L7; RealsForm;
  956.           write(lst,TempS,' ',L7S,'                 ');
  957.           write(lst,Nodes[1,I],'       ',Nodes[2,I]) end;
  958.       'O' : begin write(lst,'OpA     ');
  959.           TempR := Value[2,I]; RealsForm; write(lst,TempS,' G(V)     ');
  960.           TempR := Value[1,I]/R7; RealsForm; write(lst,TempS,' ',R7S,'O  ');
  961.           write(lst,Nodes[3,I],' +In   ',Nodes[4,I],' -In   '
  962.                ,Nodes[2,I],' +Out   ',Nodes[1,I],' -Out  ') end;
  963.       'F' : begin write(lst,'FET     '); TempR := Value[1,I]; RealsForm;
  964.           write(lst,TempS,' Gain(A/V)                 ');
  965.           write(lst,Nodes[2,I],' S     ',Nodes[3,I],' G     '
  966.                ,Nodes[1,I],' D      ') end;
  967.       'B' : begin write(lst,'BiPolar '); TempR := Value[2,I]; RealsForm;
  968.           write(lst,TempS,' Beta'); TempR := Value[1,I]/R7; RealsForm;
  969.           write(lst,TempS,' ',R7S,' B/E ');
  970.           write(lst,Nodes[2,I],' E     ',Nodes[3,I],' B     '
  971.                ,Nodes[1,I],' C     ') end;
  972.       'L' : begin write(lst,'Line    '); TempR := Value[2,I]/F7; realsForm;
  973.           write(lst,TempS,' ',F7S,' L/4   ');
  974.           TempR := Value[1,I]/R7; RealsForm; write(lst,TempS,' ',R7S,'    ');
  975.           write(lst,Nodes[3,I],' Lin   ',Nodes[4,I],' Gin   '
  976.                ,Nodes[2,I],' Lout  ',Nodes[1,I],' Gout  ') end;
  977.       end;
  978.       writeln(lst)
  979.     end; writeln(lst); writeln(lst); writeln(lst)
  980.   end;
  981.  
  982. procedure DeleteComp;
  983.   begin
  984.     for I := NC to NN do
  985.     begin
  986.       Compo[I] := Compo[I+1];
  987.       Value[1,I] := Value[1,I+1];
  988.       Value[2,I] := Value[2,I+1];
  989.       Nodes[1,I] := Nodes[1,I+1];
  990.       Nodes[2,I] := Nodes[2,I+1];
  991.       Nodes[3,I] := Nodes[3,I+1];
  992.       Nodes[4,I] := Nodes[4,I+1];
  993.     end;
  994.     NN := NN - 1; NC := NN;
  995.     for I := 6 to 24 do begin gotoXY(1,I); ClrEol; end;
  996.     gotoXY(1,6); writeln('    Comp    Value                       Nodes---');
  997.     for I := 1 to NC do
  998.     begin if I = 20 then read(kbd,Ch); Ch := #0; ScreenL end;
  999.     writeln; writeln('No. Comp    Value                       Nodes---');
  1000.   end;
  1001.  
  1002. procedure Correct;
  1003.   begin clrscr; writeln('Correction Mode'); writeln;
  1004.     writeln('          Name of Circut is ',CirName);
  1005.     gotoXY(29,3); read(TempS);
  1006.     if TempS <> '' then CirName := TempS; gotoXY(29,3);
  1007.     writeln(CirName,'           '); UnitsAre;
  1008.     gotoXy(4,5); write('No of Nodes = ',ND);
  1009.     gotoXY(22,5); write('Input = ',NI);
  1010.     gotoXY(34,5); write('Output = ',NO);
  1011.     repeat repeat repeat gotoXY(18,5); read(Ch1);
  1012.           if Ch1 <> '' then val(Ch1,ND,Err); gotoXY(18,5); write(ND,' ');
  1013.           if (ND<3) or (ND>NoN) then Beep
  1014.         until (ND>2) and (ND<=NoN); gotoXY(30,5); read(Ch1);
  1015.         if Ch1 <> '' then val(Ch1,NI,Err); gotoXY(30,5);
  1016.         write(NI,' '); if NI > ND then Beep
  1017.       until NI <= ND; gotoXY(43,5); read(Ch1);
  1018.       if Ch1 <> '' then val(Ch1,NO,Err); gotoXY(43,5);
  1019.       write(NO,' '); if NO > ND then Beep
  1020.     until NO <= ND; writeln;
  1021.     writeln('    Comp    Value                       Nodes---');
  1022.     for I := 1 to NC do
  1023.     begin if I = 20 then read(kbd,Ch); ScreenL end;
  1024.     writeln; writeln('No. Comp    Value                       Nodes---');
  1025.     NN := NC;
  1026.     repeat
  1027.       read(Ch1); val(Ch1,NC,Err);
  1028.       if (Ch1='') or (NC=0) or (NC>NN+1) then Ch := #13 else
  1029.       begin if NC = NN + 1 then begin NN:=NN+1; Compo[NC]:='D'; end;
  1030.         gotoXY(1,whereY); write(NC,'     R/C/I/O/F/B/L   D');
  1031.         repeat FLGC := true; gotoXY(5,whereY); write(Compo[NC]);
  1032.           gotoXY(5,whereY); read(kbd,Ch);
  1033.           if Ch <> #13 then Compo[NC]:=Ch;
  1034.           Ch:=Compo[NC];
  1035.           gotoXY(5,whereY); write(Compo[NC]);
  1036.           case Ch of
  1037.             'R','r' : begin Resistor;writeln; end;
  1038.             'C','c' : begin Capacitor;writeln; end;
  1039.             'I','i' : begin Inductor;writeln; end;
  1040.             'O','o' : begin OpAmp; writeln; end;
  1041.             'F','f' : begin FET; writeln; end;
  1042.             'B','b' : begin BiPolarT;writeln; end;
  1043.             'L','l' : begin Line; writeln; end;
  1044.             'D','d' : DeleteComp;
  1045.             #13 : begin end
  1046.             else begin Beep; FLGC := false; end
  1047.           end
  1048.         until FLGC
  1049.       end
  1050.     until Ch = #13;
  1051.     NC := NN
  1052.   end;
  1053.  
  1054.  
  1055. procedure ShowDir(FileSpec : String80; Attr : byte);
  1056. {ManipulatingDiskFiles"TURBO PASCAL TIPS,TRICKS&TRAPS"QUEbyRugg&Feldman}
  1057.   type RegList = record
  1058.     AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : integer
  1059.     end;
  1060.   const Columns = 5;
  1061.   var J, ColSize : integer;
  1062.     Reg : RegList;
  1063.     DTA : array[1..43] of byte;
  1064.   begin ColSize := 80 div Columns; Reg.DX := ofs(DTA);
  1065.     Reg.DS := seg(DTA); Reg.AX := $1A00; msdos(Reg);
  1066.     writeln('** Directory listing for ',FileSpec);
  1067.     FileSpec := FileSpec + chr(0); Reg.DX := ofs(FileSpec[1]);
  1068.     Reg.DS := seg(FileSpec[1]); Reg.CX := Attr; Reg.AX := $4E00;
  1069.     msdos(Reg);
  1070.     if lo(Reg.AX) <> 0 then
  1071.       begin writeln('** No filenames found. **'); exit end;
  1072.     if DTA[22] and $18 <> 0 then write('[D]'); J := 31;
  1073.     while DTA[J] <> 0 do
  1074.       begin write(chr(DTA[J])); J := J + 1 end;
  1075.     repeat Reg.DX := ofs(DTA); Reg.DS := seg(DTA); Reg.AX := $4F00;
  1076.       msdos(Reg);
  1077.       if lo(Reg.AX) = 0 then
  1078.         begin if whereX > (Columns - 1) * ColSize + 1 then writeln;
  1079.           while (whereX mod ColSize) <> 1 do write(' ');
  1080.           if DTA[22] and $10 <> 0 then write('[D]'); J := 31;
  1081.           while DTA[J] <> 0 do begin write(chr(DTA[J])); J := J + 1 end
  1082.         end
  1083.     until lo(Reg.AX) <> 0;
  1084.     writeln; writeln('** End of directory listing. **')
  1085.   end;
  1086.  
  1087. procedure LoadData;
  1088.   begin clrscr; ShowDir('B:*.*',$10); writeln;
  1089.     writeln('Name of Circuit to load is (exclude extension .NOD) ');
  1090.     write('E to exit'); gotoXY(53,whereY-1); readln(TempS);
  1091.     while (TempS <> 'E') and (TempS <> 'e') and (TempS <> '') do
  1092.     begin writeln('Loading KBD Data from Disk B:'); CirName := TempS;
  1093.       CircuitName := 'B:' + CirName + '.NOD';
  1094.       assign(Infile, CircuitName);
  1095.       reset(Infile);
  1096.       read(Infile,KbdRecord); F7S := KbdRecord.Parts;
  1097.         F7 := KbdRecord.Value1; R7 := KbdRecord.Value2;
  1098.         NC := KbdRecord.Nodes1; ND := KbdRecord.Nodes2;
  1099.         NI := KbdRecord.Nodes3; NO := KbdRecord.Nodes4;
  1100.       read(Infile,KbdRecord); R7S := KbdRecord.Parts;
  1101.         C7 := KbdRecord.Value1; L7 := KbdRecord.Value2;
  1102.         F3 := KbdRecord.Nodes1; Y1 := KbdRecord.Nodes2;
  1103.         Y2 := KbdRecord.Nodes3; TempI := KbdRecord.Nodes4;
  1104.         if TempI = 1 then FLGA := true else FLGA := false;
  1105.       read(Infile,KbdRecord); C7S := KbdRecord.Parts;
  1106.         F1 := KbdRecord.Value1; F2 := KbdRecord.Value2;
  1107.       read(Infile,KbdRecord); L7S := KbdRecord.Parts;
  1108.       for I := 1 to NC do
  1109.       begin read(Infile,KbdRecord); Compo[I] := KbdRecord.Parts;
  1110.           Value[1,I] := KbdRecord.Value1; Value[2,I] := KbdRecord.Value2;
  1111.           Nodes[1,I] := KbdRecord.Nodes1; Nodes[2,I] := KbdRecord.Nodes2;
  1112.           Nodes[3,I] := KbdRecord.Nodes3; Nodes[4,I] := KbdRecord.Nodes4
  1113.       end;
  1114.       close(Infile); TempS := 'E'
  1115.     end
  1116.   end;
  1117.  
  1118. procedure SaveData;
  1119.   begin if NC > 1 then
  1120.     begin clrscr; ShowDir('B:*.*',$10); writeln;
  1121.       writeln('Name of Circut to save is ',CirName);
  1122.       write('E to exit'); gotoXY(27,whereY-1); readln(TempS);
  1123.       while (TempS <> 'E') and (TempS <> 'e') do
  1124.       begin if TempS <> '' then CirName := TempS; gotoXY(27,whereY-1);
  1125.         writeln(CirName,'           '); writeln;
  1126.         writeln('Saving KBD Data to Disk B:'); writeln;
  1127.         writeln('Name of Circuit is ',CirName);
  1128.         CircuitName := 'B:' + CirName + '.NOD';
  1129.         assign(Outfile, CircuitName);
  1130.         rewrite(Outfile); KbdRecord.Parts := F7S;
  1131.           KbdRecord.Value1 := F7; KbdRecord.Value2 := R7;
  1132.           KbdRecord.Nodes1 := NC; KbdRecord.Nodes2 := ND;
  1133.           KbdRecord.Nodes3 := NI; KbdRecord.Nodes4 := NO;
  1134.         write(Outfile, KbdRecord); KbdRecord.Parts := R7S;
  1135.           KbdRecord.Value1 := C7; KbdRecord.Value2 := L7;
  1136.           KbdRecord.Nodes1 := F3; KbdRecord.Nodes2 := Y1;
  1137.           if FLGA then TempI := 1 else TempI := 0;
  1138.           KbdRecord.Nodes3 := Y2; KbdRecord.Nodes4 := TempI;
  1139.         write(Outfile, KbdRecord); KbdRecord.Parts := C7S;
  1140.           KbdRecord.Value1 := F1; KbdRecord.Value2 := F2;
  1141.           KbdRecord.Nodes1 := 0; KbdRecord.Nodes2 := 0;
  1142.           KbdRecord.Nodes3 := 0; KbdRecord.Nodes4 := 0;
  1143.         write(Outfile, KbdRecord); KbdRecord.Parts := L7S;
  1144.           KbdRecord.Value1 := 0.0; KbdRecord.Value2 := 0.0;
  1145.           KbdRecord.Nodes1 := 0; KbdRecord.Nodes2 := 0;
  1146.           KbdRecord.Nodes3 := 0; KbdRecord.Nodes4 := 0;
  1147.         write(Outfile, KbdRecord);
  1148.         for I := 1 to NC do
  1149.         begin KbdRecord.Parts := Compo[I];
  1150.           KbdRecord.Value1 := Value[1,I]; KbdRecord.Value2 := Value[2,I];
  1151.           KbdRecord.Nodes1 := Nodes[1,I]; KbdRecord.Nodes2 := Nodes[2,I];
  1152.           KbdRecord.Nodes3 := Nodes[3,I]; KbdRecord.Nodes4 := Nodes[4,I];
  1153.           write(Outfile, KbdRecord)
  1154.         end;
  1155.         close(Outfile); Delay(1000); TempS := 'E'
  1156.       end
  1157.     end
  1158.   else begin clrscr; Beep; writeln('Enter Circuit !!'); Delay(2000) end
  1159.   end;
  1160.  
  1161. procedure ScreenSweep;
  1162.   begin clrscr; writeln('       The Name of Circuit is ',CirName);
  1163.     if NC > 1 then
  1164.     begin FreqLimits; LoadArray; writeln;
  1165.       writeln(' Freq ',F7S,'                   Gain dB         Phase deg');
  1166.       FLG := 1; SweepLoop; FLG := 0; read(kbd,Chm)
  1167.     end else begin writeln('Enter Circuit !!'); Beep; Delay(2000) end
  1168.   end;
  1169.  
  1170. procedure PrinterSweep;
  1171.   begin clrscr; writeln('       The Name of Circuit is ',CirName);
  1172.     if NC > 1 then
  1173.     begin FreqLimits; LoadArray;
  1174.       writeln(lst,'       The Name of Circuit is ',CirName); writeln(lst);
  1175.       writeln(lst,' Freq ',F7S,'                   Gain dB         Phase deg');
  1176.       FLG := 2; SweepLoop; FLG := 0
  1177.     end else begin writeln('Enter Circuit !!'); Beep; Delay(2000) end
  1178.   end;
  1179.  
  1180. procedure IfKeyPress;
  1181.   begin if KeyPressed then begin read(kbd,Chm) end;
  1182.     if KeyPressed then begin read(kbd,Chm) end;
  1183.     if KeyPressed then begin read(kbd,Chm) end;
  1184.     read(kbd,Chm); TextMode(C80)
  1185.   end;
  1186.  
  1187. procedure GraphSweep;
  1188.   begin clrscr; if NC > 1 then
  1189.     begin SweepStart; FreqLimits; GainLimits;
  1190.       if TM='Y' then TimeLimits; GraphColorMode;
  1191.       draw(0,0,319,0,1); draw(319,0,319,200,1); draw(0,199,0,0,1);
  1192.       if F2 / F1 < 3 then LinearFreqGrid else LogFreqGrid; FreqLabel;
  1193.       GainGrid; GainLabel; if(PS='Y')and(TM='N')and(RLOS='N')then PhaseLabel;
  1194.       if (TM='Y') and (RLOS='N') then TimeLabel; if RLOS='Y' then RetLossLabel;
  1195.       LoadArray; SweepLoop; IfKeyPress;
  1196.     end else begin writeln('Enter Circuit !!'); Beep; Delay(2000) end
  1197.   end;
  1198.  
  1199. procedure GraphLabel;
  1200.   begin GraphColorMode; draw(0,0,319,0,1);
  1201.     draw(319,0,319,199,1); draw(0,199,0,0,1);
  1202.     if F2 / F1 < 3 then LinearFreqGrid else LogFreqGrid; FreqLabel;
  1203.     GainGrid; GainLabel; if (PS='Y')and(TM='N')and(RLOS='N') then PhaseLabel;
  1204.     if (TM='Y') and (RLOS='N') then TimeLabel; if RLOS='Y' then RetLossLabel;
  1205.     LA := 0; LT := 0; LX := 0; D := 1;
  1206.   end;
  1207.  
  1208. Procedure DrawOverLast;
  1209.   begin repeat draw(round(LX),round(LA),round(Last[1,D]),round(Last[2,D]),1);
  1210.     if PS='Y' then begin draw(round(LX),round(LT),round(Last[1,D]),
  1211.     round(Last[3,D]),1); LT := Last[3,D]; end;
  1212.     if TM='Y' then begin if D > 2 then draw(round(LX),round(ML),
  1213.     round(Last[1,D]), round(Last[4,D]),1); ML := Last[4,D]; end;
  1214.     if RLOS='Y' then begin draw(round(LX),round(LRET),round(Last[1,D]),
  1215.     round(Last[5,D]),1); LRET:= Last[5,D]; end;
  1216.     LX := Last[1,D]; LA := Last[2,D]; D := D + 1 until Last[1,D] = 300;
  1217.   end;
  1218.  
  1219. Procedure DrawOverRef;
  1220.   begin repeat draw(round(LX),round(LA),round(Ref[1,D]),round(Ref[2,D]),1);
  1221.     if PS='Y' then begin draw(round(LX),round(LT),round(Ref[1,D]),
  1222.     round(Ref[3,D]),1); LT := Ref[3,D]; end;
  1223.     if TM='Y' then begin if D > 2 then draw(round(LX),round(ML),
  1224.     round(Ref[1,D]), round(Ref[4,D]),1); ML := Ref[4,D]; end;
  1225.     if RLOS='Y' then begin draw(round(LX),round(LRET),round(Ref[1,D]),
  1226.     round(Ref[5,D]),1); LRET:= Ref[5,D]; end;
  1227.     LX := Ref[1,D]; LA := Ref[2,D]; D := D + 1 until Ref[1,D] = 300;
  1228.   end;
  1229.  
  1230. procedure OverGraph;
  1231.   begin if NC > 1 then
  1232.     begin if Last[1,1] <> 300 then
  1233.       begin GraphLabel; DrawOverLast; LoadArray; SweepLoop; IfKeyPress;
  1234.       end else begin clrscr; writeln('No Graph !!'); Beep; Delay(2000) end
  1235.     end else begin clrscr; writeln('Enter Circuit !!'); Beep; Delay(2000) end
  1236.   end;
  1237.  
  1238. procedure OverRefGraph;
  1239.   begin if NC > 1 then
  1240.     begin if Ref[1,1] <> 300 then
  1241.       begin GraphLabel; DrawOverRef; LoadArray; SweepLoop; IfKeyPress;
  1242.       end else begin clrscr; writeln('Save Ref Graph !!');Beep;Delay(2000) end
  1243.     end else begin clrscr; writeln('Enter Circuit !!'); Beep; Delay(2000) end
  1244.   end;
  1245.  
  1246. procedure OverLastAndRefGraph;
  1247.   begin if NC > 1 then
  1248.     begin if Ref[1,1] <> 300 then
  1249.       begin GraphLabel; DrawOverLast; LA := 0; LT := 0; LX := 0; D := 1;
  1250.         DrawOverRef; LoadArray; SweepLoop; IfKeyPress;
  1251.       end else begin clrscr; writeln('Save Ref Graph !!');Beep;Delay(2000) end
  1252.     end else begin clrscr; writeln('Enter Circuit !!'); Beep; Delay(2000) end
  1253.   end;
  1254.  
  1255. procedure StoreRefGraph;
  1256.   begin if Last[1,1] <> 300 then
  1257.     begin for I := 1 to 5 do
  1258.       begin  for J := 1 to 300 do Ref[I,J] := Last[I,J] end
  1259.     end else begin clrscr; writeln('No Last Graph !!');Beep;Delay(2000) end
  1260.   end;
  1261.  
  1262. procedure ViewGraph;
  1263.   begin if Last[1,1] <> 300 then
  1264.     begin GraphLabel; DrawOverLast; IfKeyPress;
  1265.     end else begin clrscr; writeln('No Last Graph !!');Beep; Delay(2000) end
  1266.   end;
  1267.  
  1268. procedure ViewRefGraph;
  1269.   begin if Ref[1,1] <> 300 then
  1270.     begin GraphLabel; DrawOverRef; IfKeyPress;
  1271.     end else begin clrscr; writeln('No Ref Graph !!');Beep; Delay(2000) end
  1272.   end;
  1273.  
  1274. procedure Instructions;
  1275.   begin
  1276.     clrscr; writeln('   This is a nodal program that has a minimum of 3 and');
  1277.     writeln('a maximum of ',NoN,' nodes.');
  1278.     writeln('   It will model resistors, capacitors, inductors, ');
  1279.     writeln('opamps, transmission lines, field effect & bipolar transistors.');
  1280.     writeln('   A maximim of ',NoC,' components can be entered.');
  1281.     writeln('   Components can be added in the correction mode if ');
  1282.     writeln('the next higher component number is used, or deleated by');
  1283.     writeln('using the D key.');
  1284.     writeln('   If the frequency sweep ratio is < 3 the sweep is');
  1285.     writeln('linear, otherwise the sweep is logarithmic.');
  1286.     writeln('   When the sweep is logarithmic, the decade frequency label');
  1287.     writeln('is the exponent of the frequency, or K, M or G.');
  1288.     writeln('   If only one computation is desired, allow 2');
  1289.     writeln('computations by selecting the desired frequency as the start,');
  1290.     writeln('a higher frequency as the stop and 1 step as the increment.');
  1291.     writeln('   A maximim of 300 points are stored for last and ref graphs.');
  1292.     writeln('   During frequency sweep, an ESC key will exit.');
  1293.     writeln('     An A key is for turning on automatic step size.');
  1294.     writeln('     A  T key is for changing to twice step size, auto off.');
  1295.     writeln('     An H key is for changing to half step size, auto off.');
  1296.     writeln('     An P key is for turning phase plot on.');
  1297.     writeln('     An R key is for turning return loss plot on.');
  1298.     writeln('     An O key is for turning phase or return loss plot off');
  1299.     read(kbd,Chm);
  1300.     writeln('   Time is computed using the last and present computations');
  1301.     writeln('   For Return Loss, node 1 must be input and a source resistor');
  1302.     writeln('      must be from node 1 to node 2.');
  1303.     writeln('   The right edge labeling will be phase, time or return loss');
  1304.     writeln('      whichever is last selected.');
  1305.     writeln('   When using an open circuited transmission line, load the');
  1306.     writeln('open end with a 1 M resistor.');
  1307.     writeln('   A t or T key in Menu will load test Ckts.');
  1308.     writeln; writeln('Ref  EDN Sept 1, 1982   Nodal equations');
  1309.     writeln('     RF DESIGN EXPO 86     Transmission line equations');
  1310.     writeln; writeln('Rev. ',TDN);
  1311.     read(kbd,Chm)
  1312.   end;
  1313.  
  1314. procedure Test1;
  1315.   begin clrscr; writeln('Entering Test 1 Circuit');
  1316.     ClearData; ClearDeter; Units; Y1:=5; Y2:=-40; FLGA := false;
  1317.     Last[1,1] := 300; Ref[1,1] := 300; I := 0; J := 0; K := 0;
  1318.     L := 0; N := 0; F3 := 20; PS:='Y'; TM:='N'; RLOS:='N';
  1319.     CirName:='Test1'; ND:=3; NI:=1; NO:=3; F1:=1E3; F2:=1E9; NC:=4;
  1320.     Compo[1]:='R'; Compo[2]:='R'; Compo[3]:='R'; Compo[4]:='C';
  1321.     Value[1,1]:=50; Value[1,2]:=0.0001; Value[1,3]:=50; Value[1,4]:=1E-8;
  1322.     Nodes[1,1]:=1; Nodes[1,2]:=2; Nodes[1,3]:=3; Nodes[1,4]:=3;
  1323.     nodes[2,1]:=2; Nodes[2,2]:=3; Nodes[2,3]:=0; Nodes[2,4]:=0
  1324.   end;
  1325. procedure Test2;
  1326.   begin clrscr; writeln('Entering Test 2 Circuit');
  1327.     ClearData; ClearDeter; Units; Y1:=0; Y2:=-100; FLGA := true;
  1328.     Last[1,1] := 300; Ref[1,1] := 300; I := 0; J := 0; K := 0;
  1329.     L := 0; N := 0; F3 := 20; PS:='Y'; TM:='N'; RLOS:='N';
  1330.     CirName:='Test2'; ND:=3; NI:=1; NO:=3; F1:=1E3; F2:=1E9; NC:=4;
  1331.     Compo[1]:='R'; Compo[2]:='I'; Compo[3]:='C'; Compo[4]:='R';
  1332.     Value[1,1]:=50; Value[1,2]:=1E-3; Value[1,3]:=1E-11; Value[1,4]:=50;
  1333.     Nodes[1,1]:=1; Nodes[1,2]:=2; Nodes[1,3]:=2; Nodes[1,4]:=3;
  1334.     nodes[2,1]:=2; Nodes[2,2]:=3; Nodes[2,3]:=3; Nodes[2,4]:=0
  1335.   end;
  1336.  
  1337. procedure Menu;
  1338.   begin repeat repeat clrscr;
  1339.         writeln('     NODAL NETWORK ANALYZER'); writeln;
  1340.         writeln('Name of Circut is ',CirName); writeln;
  1341.         writeln('1    Enter Data From Kbd');
  1342.         writeln('2    Change Units');
  1343.         writeln('3    List Kbd Data to Screen');
  1344.         writeln('4    List Kbd Data to Printer');
  1345.         writeln('5    Correct Kbd Data');
  1346.         writeln('6    Load Kbd Data from Disk B:');
  1347.         writeln('7    Save Kbd Data to Disk B:');
  1348.         writeln('8    Freq Sweep Tabular to Screen');
  1349.         writeln('9    Freq Sweep Tabular to Printer');
  1350.         writeln('0    Freq Sweep to Graph');
  1351.         writeln('-    Freq Sweep over last Graph');
  1352.         writeln('=    Freq Sweep over ref Graph');
  1353.         writeln('+    Freq Sweep over last & ref Graph');
  1354.         writeln('S    Store last Graph as ref Graph');
  1355.         writeln('V    View last Graph');
  1356.         writeln('B    View ref Graph');
  1357.         writeln('I    Instructions');
  1358.         writeln('EE   END');
  1359.         read(kbd,Chm);
  1360.         case Chm of
  1361.           '1' : EnterData; '2' : ChangeUnits; '3' : ScreenList;
  1362.           '4' : PrinterList; '5' : Correct; '6' : LoadData;
  1363.           '7' : SaveData; '8' : ScreenSweep; '9' : PrinterSweep;
  1364.           '0' : GraphSweep; '-' : OverGraph; '=' : OverRefGraph;
  1365.           '+' : OverLastAndRefGraph; 'S','s' : StoreRefGraph;
  1366.           'V','v' : ViewGraph; 'B','b' : ViewRefGraph;
  1367.           'I','i' : Instructions; 't' : Test1; 'T' : Test2;
  1368.         end
  1369.       until (Chm='E') or (Chm='e'); read(kbd,Chm);
  1370.     until (Chm='E') or (Chm='e')
  1371.   end;
  1372.  
  1373. BEGIN
  1374.   CirName := '    '; ClearData; ClearDeter; PS := 'N'; TM := 'N'; RLOS := 'N';
  1375.   F1 := 1E6; F2 := 2E6; F3 := 20; Y1 := 0; Y2 := -40; ND := 3;
  1376.   NI := 1; NO := 3; NC := 0; T1 := 10; T2 := 1E-3;
  1377.   FLG := 0; Last[1,1] := 300; Ref[1,1] := 300; Units; FLGA := false; Menu
  1378. END.
  1379.