1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140
| program Gauss;
uses crt;
type
tmat=array[1..10,1..10] of real;
var
a:array[1..10,1..10] of real;
x:array[1..10] of real;
i,j,k,l,n,m,found :integer;
P, temp:real;
procedure writematrix (a:tmat);
var
i,j : integer ;
begin
for i:=1 to n do
begin
for j:=1 to n do
begin
write(a[i,j]:4:4,' x',j);
if j < n then write(' + ');
end;
writeln(' = ',a[i,n+1]:4:4);
end;
writeln;
end;
begin
//Creation of the matrix
Writeln('Matrix order ');
readln(n);
for i:=1 to n do
begin
for j:=1 to n do
begin
write('A',i,j,' ');
readln(a[i,j]);
end;
write('B',i,' ');
readln(a[i,n+1]);
end;
clrscr;
Writematrix(a);
//Gaussian elimination
for i := 1 to n-1 do
begin
if a[i,i]<>0 then
begin
for k := i+1 to n do
for l:= i to n+1 do
a[k,l] := a[k,l] - (a[i,l]*a[k,i]/a[i,i]) ; ;
writematrix(a)
end
else
begin
found:= 0 ;
l:= i+1 ;
while found =0 do
begin
if a [i,l]<>0 then
begin
found := l ;
for m:= i to n do
begin
temp:=a[m,i] ;
a[m,i]:=a[m,found] ;
a[m,found]:=temp ;
end ;
writematrix(a);
writeln('permutee')
end ;
if a [i,l] = 0 then
begin
l:= l+1 ;
if l>n then
found:=-1 ;
end;
end ;
If found= -1 then
begin
writeln('impossible, enter to exit');
readln;
exit;
end
else
for k := i+1 to n do
for l:= i to n+1 do
a[k,l] := a[k,l] - (a[i,l]*a[k,i]/a[i,i]) ; ;
end;
end;
If a[n,n] = 0
then
begin
writeln('impossible, enter to exit') ;
readln;
exit;
end;
readln;
//calculate the values of x
If a[i,i]= 0
then
begin
writeln('det=0, press enter');
readln;
exit;
end
else
x[n] := a[n,n+1] / a[n,n];
for i:=n downto 1 do
begin
x[i]:=a[i,n+1];
for j:=i+1 to n do
begin
x[i]:=x[i] - a[i,j]*x[j];
end;
x[i]:=x[i]/a[i,i];
end;
readln;
//write the results
for i:=1 to n do
write('x',i,' = ',x[i]:4:4,' ');
readln;
end. |
Partager