home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / turbopas / pas_sci.arc / SOLVGJ.PAS < prev    next >
Pascal/Delphi Source File  |  1985-07-22  |  2KB  |  93 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.  
  74. {$I C:GAUSSJ.LIB}
  75.  
  76. begin        { MAIN program }
  77.   first:=true;
  78.   ClrScr;
  79.   writeln;
  80.   writeln('Simultaneous solution by Gauss-Jordan elimination');
  81.   repeat
  82.     get_data(a,y,n,m);
  83.     if n>1 then
  84.       begin
  85.     for i:=1 to n do
  86.       for j:=1 to n do
  87.         b[i,j]:=a[i,j];    { setup work array }
  88.     gaussj(b,y,coef,n,error);
  89.     if not error then write_data
  90.       end
  91.   until n<2
  92. end.
  93.