Cod sursa(job #1548359)

Utilizator ili226Vlad Ilie ili226 Data 10 decembrie 2015 20:25:59
Problema Algoritmul lui Gauss Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.01 kb
const eps=0.0000001;
var n,m,i,j,k,l,u:word;
    a:array[1..303,1..303]of real;
    sol:array[1..303]of real;
    f:text;
    aux:real;
begin
assign(f,'gauss.in');
reset(f);
readln(f,n,m);
for i:=1 to n do
 for j:=1 to m+1 do
  read(f,a[i,j]);
close(f);
i:=1;j:=1;
while (i<=n)and(j<=m) do
 begin
  k:=i;
  while ((a[k,j]<eps)and(a[k,j]>-eps))and(k<>n+1)do
   inc(k);
  if k=n+1 then
   inc(j)
           else
   begin
    if i<>k then
     for l:=1 to m+1 do
      begin
       aux:=a[i,l];
       a[i,l]:=a[k,l];
       a[k,l]:=aux
      end;
    for l:=j+1 to m+1 do
     a[i,l]:=a[i,l]/a[i,j];
    a[i,j]:=1;
    for u:=i+1 to n do
     begin
      for l:=j+1 to m+1 do
       a[u,l]:=a[u,l]-a[u,j]*a[i,l];
      a[u,j]:=0;
     end;
    inc(j);inc(i)
   end;
 end;
assign(f,'gauss.out');
for i:=n downto 1 do
 begin
 sol[i]:=a[i,m+1];
  for j:=m downto m-(n-i)+1 do
   sol[i]:=sol[i]-a[i,j]*sol[j]
 end;
rewrite(f);
for i:=1 to m do
 write(f,sol[i]:10,' ');
close(f);
end.