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