Cod sursa(job #727709)

Utilizator ionutz32Ilie Ionut ionutz32 Data 28 martie 2012 11:01:48
Problema Algoritmul lui Gauss Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.69 kb
var a:array[0..305,0..305] of double;
p:array[0..305] of integer;
sol:array[0..305] of double;
n,m,i,j,x,k,ln:longint;
aux:double;
f,g:text;
gasit:boolean;
ok:boolean;
begin
assign(f,'gauss.in');
assign(g,'gauss.out');
reset(f);rewrite(g);
read(f,n,m);
for i:=1 to n do
    for j:=1 to m+1 do
        read(f,a[i,j]);
i:=1;
j:=1;
while (i<=n) and (j<=m) do
      begin
      if a[i,j]=0 then
         begin
         gasit:=false;
         for x:=i+1 to n do
             if abs(a[x,j])>1e-10 then
                begin
                gasit:=true;
                for k:=j to m+1 do
                    begin
                    aux:=a[i,k];
                    a[i,k]:=a[x,k];
                    a[x,k]:=aux;
                    end;
                break;
                end;
         end
      else
          gasit:=true;
      if gasit=false then
         begin
         inc(j);
         continue;
         end;
      aux:=a[i,j];
      for k:=j to m+1 do
          a[i,k]:=a[i,k]/aux;
      for ln:=i+1 to n do
          begin
          aux:=a[ln,j];
          for k:=j to m+1 do
              a[ln,k]:=a[ln,k]-a[i,k]*aux;
          end;
      p[i]:=j;
      inc(i);
      inc(j);
      end;
ok:=true;
for i:=n downto 1 do
    begin
    if p[i]=0 then
       if abs(a[i,m+1])>=1e-10 then
          begin
          ok:=false;
          break;
          end
       else
           continue;
    sol[p[i]]:=a[i,m+1];
    for j:=i+1 to m do
        sol[p[i]]:=sol[p[i]]-a[i,j]*sol[j];
    sol[p[i]]:=sol[p[i]]/a[i,p[i]];
    end;
if ok then
   for i:=1 to m do
       write(g,sol[i]:0:8,' ')
else
    writeln(g,'Imposibil');
close(f);close(g);
end.