Метод Гаусса решения системы линейных уравнений

Метод Гаусса решения системы линейных уравнений

{ **** UBPFD *********** by kladovka.net.ru ****
>>
Рещение системы линейных уравнений (возможно переопределенной) методом Гаусса.
Определяется ситуация, что система не имеет рещений. Ситуация, когда система
имеет более чем одно решение не рассматривается. В случае удачного завершения
возвращает нуль.
Зависимости: System
Автор: Mystic, <a href="mailto:mystic2000@newmail.ru">mystic2000@newmail.ru</a>, ICQ:125905046, Харьков
Copyright: (C) Mystic
Дата: 25 апреля 2002 г.
********************************************** }

function LinGauss(M, N: Integer; Data: PExtended; X: PExtended): Cardinal;
var
 PtrData: PExtended;
 PtrData1, PtrData2: PExtended;
 Temp: Extended;
 I, J, Row: Integer;
 Max: Extended;
 MaxR: Integer;
begin
 Assert(M >= N, 'Invalid start data');
 for I := 0 to N-1 do // Для каждой переменной
 begin
  // 1. Поиск максимального элемента
  PChar(PtrData) := PChar(Data) + I*(N+2)*SizeOf(Extended);
  MaxR := I;
  Max := PtrData^;
  for J := I+1 to M-1 do
  begin
  PChar(PtrData) := PChar(PtrData) + (N+1)*SizeOf(Extended);
  if Abs(PtrData^) > Abs(Max) then
  begin
  Max := PtrData^;
  MaxR := J;
  end;
  end;
  // 2. А вдруг неразрешима?
  if Abs(Max) < 1.0E-10 then
  begin
  Result := $FFFFFFFF;
  Exit;
  end;
  // 3. Меняем местами строки
  if MaxR <> I then
  begin
  PChar(PtrData1) := PChar(Data) + MaxR*(N+1)*SizeOf(Extended);
  PChar(PtrData2) := PChar(Data) + I*(N+1)*SizeOf(Extended);
  for J := 0 to N do
  begin
  Temp := PtrData1^;
  PtrData1^ := PtrData2^;
  PtrData2^ := Temp;
  PChar(PtrData1) := PChar(PtrData1) + SizeOf(Extended);
  PChar(PtrData2) := PChar(PtrData2) + SizeOf(Extended);
  end;
  end;
  // 4. Пересчет направляющей строки
  PChar(PtrData) := PChar(Data) + I*(N+1)*SizeOf(Extended);
  for J := 0 to N do
  begin
  PtrData^ := PtrData^ / Max;
  PChar(PtrData) := PChar(PtrData) + SizeOf(Extended);
  end;
  // 5. Пересчет всей оставшйся части таблицы
  PtrData1 := Data;
  for Row := 0 to M-1 do
  begin
  if Row = I then
  begin
  PChar(PtrData1) := PChar(PtrData1) + (N+1)*SizeOf(Extended);
  Continue;
  end;
  PChar(PtrData2) := PChar(Data) + I*(N+1)*SizeOf(Extended);
  Temp := PExtended(PChar(PtrData1) + I*SizeOf(Extended))^;
  for J := 0 to N do
  begin
  PtrData1^ := PtrData1^ - Temp * PtrData2^;
  PChar(PtrData1) := PChar(PtrData1) + SizeOf(Extended);
  PChar(PtrData2) := PChar(PtrData2) + SizeOf(Extended);
  end;
  end;
 end;
 // 6. Проверка того, что система переопределена
 PChar(PtrData) := PChar(Data) + N*(N+1)*SizeOf(Extended);
 for I := N to M-1 do
  for J := 0 to N do
  begin
  if Abs(PtrData^) > 1.0E-10 then
  begin
  Result := $FFFFFFFF;
  Exit;
  end;
  PChar(PtrData) := PChar(PtrData) + SizeOf(Extended);
  end;
 // Все ОК
 PChar(PtrData) := PChar(Data) + N*SizeOf(Extended);
 for I := 0 to N-1 do
 begin
  X^ := PtrData^;
  PChar(X) := PChar(X) + SizeOf(Extended);
  PChar(PtrData) := PChar(PtrData) + (N+1) * SizeOf(Extended);
 end;
 Result := 0;
end;

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
Проверка
Антиспам проверка
Image CAPTCHA
...