home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / PAS_ENG.ZIP / SOLVGJ2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-07-19  |  2.0 KB  |  109 lines
  1. program solvgj2;  { -> 111 }
  2. { pascal program to perform simultaneous solution by Gauss-Jordan elimination}
  3. { there may be more equations than unknowns }
  4.  
  5. const maxr = 8;
  6.  maxc = 8;
  7.  
  8. type ary = array[1..maxr] of real;
  9.  arys = array[1..maxc] of real;
  10.  ary2s = array[1..maxr,1..maxc] of real;
  11.  ary2 = ary2s; { for square }
  12.  
  13. var y : ary;
  14.  coef,yy : arys;
  15.  a,b : ary2s;
  16.  n,m,i,j : integer;
  17.  first,
  18.  error : boolean;
  19.  
  20.  
  21. procedure get_data(var a: ary2s;
  22.      var y: ary;
  23.      var n,m: integer);
  24.  
  25. { get the values for n and arrays a,y }
  26.  
  27. var i,j : integer;
  28.  
  29. begin
  30.   writeln;
  31.   repeat
  32.     write('How many unknowns? ');
  33.     readln(m);
  34.     if first then first:=false else clrscr;
  35.   until m<maxc;
  36.   if m>1 then
  37.     begin
  38.       repeat
  39.  write('How many equations? ');
  40.  readln(n)
  41.       until n>=m;
  42.  for i:=1 to n do
  43.  begin
  44.    writeln('Equation',i:3);
  45.    for j:=1 to m do
  46.      begin
  47.        write(j:3,':');
  48.        read(a[i,j])
  49.      end;
  50.    write(',C:');
  51.    readln(y[i]) { clear line }
  52.  end; { i-loop }
  53.       writeln;
  54.       for i:=1 to n do
  55.  begin
  56.    for j:=1 to m do
  57.      write(a[i,j]:7:4,' ');
  58.    writeln(':',y[i]:7:4)
  59.  end;
  60.       writeln
  61.     end  { if n>1 }
  62. end; { procedure get_data }
  63.  
  64. procedure write_data;
  65.  
  66. { print out the answers }
  67.  
  68. var i : integer;
  69.  
  70. begin
  71.   for i:=1 to m do
  72.     write(coef[i]:9:5);
  73.   writeln
  74. end; { write_data }
  75.  
  76. {external procedure square
  77.  (  y : ary;
  78.   var  a : ary2s;
  79.   var  g : arys;
  80.  nrow,ncol : integer);}
  81.  
  82. {$I SQUARE.LIB}
  83.  
  84. {external procedure gaussj
  85.  (var  b : ary2s;
  86.   y : arys;
  87.   var      coef : arys;
  88.       ncol : integer;
  89.   var     error : boolean);}
  90.  
  91. {$I GAUSSJ.LIB}
  92.  
  93. begin  { MAIN program }
  94.   first:=true;
  95.   clrscr;
  96.   writeln;
  97.   writeln('Best fit to simultaneous equations');
  98.   writeln('By Gauss-Jordan');
  99.   repeat
  100.     get_data(a,y,n,m);
  101.     if m>1 then
  102.       begin
  103.  square(a,y,b,yy,n,m);
  104.  gaussj(b,yy,coef,m,error);
  105.  if not error then write_data
  106.       end
  107.   until m<2
  108. end.
  109.