program GaussovaEliminace;

uses crt;

var a : array[1..6,1..6] of real;     b : array[1..6] of real;     x : array[1..6] of real;

    i, j, k, m, n, o, p, r : integer;     vymena : boolean;

procedure Vstup;

 begin

  write('Vloz pocet radku soustavy linearnich rovnic : ');

  readln(n);

  for i := 1 to n do      for j := 1 to n+1 do

                             begin

                              gotoxy(10*j,i+9);

                              if (j <= n) then   begin    write('a[',i,j,']: ');   read(a[i,j])     end

                                               else   begin     write('b[',i,']: ');    readln(b[i])    end

                            end;

 end;

procedure Vymena_radku(c,d: integer);

var pom : real;        e, f : integer;

begin

  if (a[c,d] = 0) then

  begin

    e := c;

    repeat

      vymena := false;

      Inc(e);

      if (a[e,d] <> 0) then

      begin

        vymena := true;           for f := 1 to n do

                                                               begin

                                                                 pom := a[c,f];

                                                                 a[c,f] := a[e,f];

                                                                 a[e,f] := pom;

                                                               end;

        pom := b[c];         b[c] := b[e];        b[e] := pom;

      end;

    until (k = n);

  end;

end;

procedure Gauss;

var pom : real;

begin

  for i := 1 to n-1 do      for j := i to n-1 do      Vymena_radku(j,i);

  for i := 1 to n-1 do

                         begin

                            if (a[i,i] <> 0) then

                                begin

                                   k := i;

                                   repeat

                                       Inc(k);  if (a[k,i] <> 0) then

                                                     begin

                                                       pom := a[i,i]/a[k,i];

                                                       for o := i to n do            a[k,o] := a[k,o]*pom;

                                                       b[k] := b[k]*pom;

                                                     end;

                                       for o := i to n do            a[k,o] := a[k,o]-a[i,o];

                                                       b[k] := b[k]-b[i];

                                   until (k = n);

                                end;

  end;



if a[n,n]=0 then writeln('Chyba: Matice je singularni.')

  else begin

    x[n] := b[n]/a[n,n];     i := n - 1;

    repeat

      pom := 0;

      for j := i + 1 to n do

	pom := pom + a[i,j]*x[j];

      x[i] := (b[i]-pom)/a[i,i];

      i := i - 1;

    until (i = 0);

  end;

end;



procedure Vystup;

begin

  for i := 1 to n do

    for j := 1 to n+1 do

    begin

      if (j <= n) then write('  ',a[i,j]:8:2)

      else writeln('  ',b[i]:8:2);

    end;

  writeln;

end;

procedure Vystup2;

begin

  for i := 1 to n do     write('    x',i,' = ',x[i]:8:5);   writeln;  writeln;

end;



begin

  clrscr;

  writeln('Program pro vypocet soustavy linearnich rovnic pomoci ');

  writeln(' Gaussovy eliminacni metody.');    writeln;

  Vstup;

  Gauss;

  writeln;   writeln;

  write(' Trojuhelnikova matice:');

  writeln;    writeln;

  Vystup;

  write(' Reseni soustavy:');

  Vystup2;

  writeln;      write('Stiskni ENTER ...');

  readln;

end.