unit2.pas

来自「1、说明： 本书中所有的常用数值算法子过程按书中的章数分别放在以C开头」· PAS 代码 · 共 49 行

unit Unit2;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics,unit1, Controls, Forms, Dialogs;
procedure SOR(A,B,C,D,E,F:matrx2; var U:matrx2; JMAX:integer; RJAC:real);

implementation
procedure SOR(A,B,C,D,E,F:matrx2; var U:matrx2; JMAX:integer; RJAC:real);
const
    MAXITS = 1000; EPS = 0.00001; ZERO = 0; HALF = 0.5;
    QTR = 0.25;    ONE = 1;
var
    J,N,L:integer;  ANORMF,OMEGA,ANORM,AAA,BBB,RESID:real;
begin
    ANORMF:= ZERO;
    For J:=2 To JMAX - 1 do
    begin
        For L:=2 To JMAX - 1 do
            ANORMF:=ANORMF + Abs(F[J, L]);
    end;
    OMEGA:=ONE;
    For N:=1 To MAXITS do
    begin
        ANORM:=ZERO;
        For J:=2 To JMAX - 1 do
        begin
          For L:=2 To JMAX - 1 do
          begin
            If ((J + L) Mod 2) = (N Mod 2) Then
            begin
              AAA:=A[J, L] * U[J + 1, L] + B[J, L] * U[J - 1, L];
              BBB:=C[J, L] * U[J, L + 1] + D[J, L] * U[J, L - 1];
              RESID:=AAA + BBB + E[J, L] * U[J, L] - F[J, L];
              ANORM:=ANORM + Abs(RESID);
              U[J, L]:=U[J, L] - OMEGA * RESID / E[J, L];
            end;
          end;
        end;
        If N = 1 Then
            OMEGA:=ONE / (ONE - HALF * RJAC * RJAC)
        Else
            OMEGA:=ONE / (ONE - QTR * RJAC * RJAC * OMEGA);
        If (N > 1) And (ANORM < EPS * ANORMF) Then Exit;
    end;
    ShowMessage(' MAXITS exceeded');
end;
end.