ProgramGiai_He_Cramer;
UsesCrt;
Const Max=1000;{So Phuong trinh lon nhat la 1000 }
Flag: byte=0;
Type Matran_Heso=Array[1..max,1..max] of Real;
Matran_Vephai=Array[1..max] of Real;
var a:Matran_Heso; b:matran_Vephai; n:integer;
{--------------------------------------------------------------------}
Procedure Nhap;
{Thu tuc nhap du lieu tu tep van ban ! }
var f:Text; i,j:Integer;
begin
Assign(f,'Gauss.inp');
Reset(f);
Readln( f,n);
For i:=1 to n do
Begin
For j:=1 to n do
Read(f,a[i,j]);
Readln(f,b[i]) ;
End;
Close(f);
End;
{----------------------------------------------------------------------}
ProcedureDoicot(i,j:integer);
{thu tuc lam nhiem vu doi vi tri hai cot cho nhau !}
Var k:integer;tg:real;
begin
for k:=1 to n do
begin
tg:=a[k,i];
a[k,i]:=a[k,j];
a[k,j]:=tg;
end;
end;
{--------------------------------------------------------------------}
Procedure Nhanhang(i:Integer ; num:Real);
{ Thu tuc lam nhiem vu nhan mot hang voi mot so !}
Var j:integer;
Begin
For j:=i to n do
a[i,j]:=a[i,j]*num;
b[i]:=b[i]*num;
End;
{ --------------------------------------------------------------------}
ProcedureSuly(i,j:integer);
{ thu yuc lam nhiem vu su ly hai hang i va j ! }
Var k:integer;key:real;
Begin
Key:=a[j,i];
For k:=i to n do
a[j,k]:=a[i,k] * key-a[j,k];
b[j]:=b[i]*key-b[j];
End;
{ --------------------------------------------------------------------}
Procedure Khugauss;
{ Thu tuc lam nhiem vu dua HPTTT ban dau ve dang he tam giac tren}
Var i,j,cs:integer;
Begin
For i:=1 to n do
Begin
cs:=i;
While ( a[cs,cs]=0 ) and (cs<=n) do cs:=cs+1;
If cs>n then
Begin
If b[i]<>0 then flag:=1
Else
flag:=2 ;
End
Else
Begin
If cs<>i then doicot(i,cs);
Nhanhang(i,1/a[i,i]);
For j:=i+1 to n do
Suly(i,j);
End;
End;
End;
{--------------------------------------------------------------------}
Procedure Hienthi;
{Thu tuc nay lam nhiem vu hien thi ma tran he so va ve phai cua HPTTT !}
Var i,j:integer;
Begin
Writeln;
Writeln(' Ma tran ve he so va ve phai sau khi khu gause la : ');
Writeln('Ax=B');
For i:=1 to n do
Begin
For j:=1 to n do
Write(a[i,j]:6:1);
Writeln('=',b[i]:6:1);
End;
End;
{--------------------------------------------------------------------}
Procedure Inngiem;
{Thu tuc nay lam nhiem vu in ngiem cua HPTTT !}
Var i:integer;
f:text;
Begin
Assign(f,'Gauss.out');
Rewrite(f);
For i:=1 to n do
Begin
Writeln('ngiem x',i,'= ',b[i]:0:6);
Writeln(f,b[i]:0:6);
End;
Close(f);
End;
{--------------------------------------------------------------------}
Procedure Giahe;
{thu tuc kiem tra ket qua khu Gauss va giai he tam giac tren}
Var i,j:integer;
Begin
If flag=1 then
Write(' He phuong trinh vo nghiem ! ')
Else
If flag=2 then
Write(' He phuong trinhsuy bien ! nen co vo so nghiem ! ')
Else
Begin
For i:=n-1 downto 1 do
Begin
For j:=i+1 to n do
b[i]:=b[i]-a[i,j]*b[j];
End;
Inngiem;
End;
End;
{--------------------------------------------------------------------}
Begin { Main }
Clrscr;
Nhap;
Khugauss;
Hienthi;
Giahe;
Readln;
End.
[TẶNG BẠN] TRỌN BỘ Bí kíp học tốt 08 môn
