Nadesłany przez Tomasz Lubiński, 13 marca 2006 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.Pobierz pełne rozwiązanie.
Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.
Algorytm Gaussa-Seidela - Delphi/gs.dpr:
// Metoda Gaussa-Seidela
// www.algorytm.org
// (c) 2006 Tomasz Lubinski
program gs;
{$APPTYPE CONSOLE}
uses
SysUtils;
var
A: Array [1..100] of Array [1..100] of Double;
L: Array [1..100] of Array [1..100] of Double;
D: Array [1..100] of Array [1..100] of Double;
U: Array [1..100] of Array [1..100] of Double;
b: Array [1..100] of Double;
x: Array [1..100] of Double;
n, iter: Integer;
i, j, k : Integer;
begin
// Get n
Writeln('Metoda Gaussa-Seidela');
Writeln('Rozwiazywanie ukladu n-rownan z n-niewiadomymi Ax=b');
Writeln('Podaj n');
Readln(n);
if (n < 1) or (n > 100) then
begin
Writeln('Nieprawidlowa warosc parametru n');
exit;
end;
// Get values of A
for i:=1 to n do
for j:=1 to n do
begin
writeln('A[' + IntToStr(i) + '][' + IntToStr(j) +'] = ');
read(A[i][j]);
if (i = j) and (A[i][j] = 0) then
begin
writeln('Wartosci na przekatnej musza byc rozne od 0');
exit;
end;
end;
// Get values of b
for i:=1 to n do
begin
writeln('b[' + IntToStr(i) + '] = ');
read(b[i]);
end;
// Divide A into L + D + U
for i:=1 to n do
for j:=1 to n do
begin
if (i < j) then
U[i][j] := A[i][j]
else if (i > j) then
L[i][j] := A[i][j]
else
D[i][j] := A[i][j];
end;
// Calculate D^-1
for i:=1 to n do
D[i][i] := 1/D[i][i];
// Calculate D^-1 * b
for i:=1 to n do
b[i] := D[i][i] * b[i];
//Calculate D^-1 * L
for i:=1 to n do
for j:=1 to i-1 do
L[i][j] := D[i][i] * L[i][j];
//Calculate D^-1 * U
for i:=1 to n do
for j:=i+1 to n do
U[i][j] := D[i][i] * U[i][j];
//Initialize x
for i:=1 to n do
x[i] := 0;
writeln('Ile iteracji algorytmu wykonac? ');
readln(iter);
for k:=1 to iter do
for i:=1 to n do
begin
x[i] := b[i]; // x = D^-1*b -
for j:=1 to i-1 do
x[i] := x[i] - L[i][j]*x[j]; // D^-1*L * x -
for j:=i+1 to n do
x[i] := x[i] - U[i][j]*x[j]; // D^-1*U * x
end;
writeln('Wynik');
for i:=1 to n do
writeln('x[' + IntToStr(i) + '] = ' + FloatToStr(x[i]));
readln;
end.

