unit Unit2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
unit1;
procedure SPLINE(X:array of real;var Y:array of real;
N:integer; YP1, YPN:real; VAR Y2:array of real);
procedure SPLINT(XA, YA, Y2A:array of real; N:integer; X:real;var Y:real);
procedure SPLIE2(X1A, X2A:array of real; YA:matrx2;
M, N:integer;var Y2A:matrx2);
procedure SPLIN2(X1A, X2A:array of real; YA, Y2A:matrx2;
M, N:integer;var X1, X2, Y:real);
implementation
procedure SPLINE(X:array of real;var Y:array of real;
N:integer; YP1, YPN:real; VAR Y2:array of real);
var
U:array[0..100] of real;
AAA,SIG,BBB,CCC,P,QN,UN:real;
I,K:integer;
begin
If YP1 > 9.9E+29 Then
begin
Y2[1]:=0;
U[1]:=0;
end
Else
begin
Y2[1]:=-0.5;
AAA:=(Y[2] - Y[1]) / (X[2] - X[1]);
U[1]:=(3 / (X[2] - X[1])) * (AAA - YP1);
end;
For I:=2 To N - 1 do
begin
SIG:=(X[I] - X[I - 1]) / (X[I + 1] - X[I - 1]);
P:=SIG * Y2[I - 1] + 2;
Y2[I]:=(SIG - 1) / P;
AAA:=(Y[I + 1] - Y[I]) / (X[I + 1] - X[I]);
BBB:=(Y[I] - Y[I - 1]) / (X[I] - X[I - 1]);
CCC:=X[I + 1] - X[I - 1];
U[I]:=(6 * (AAA - BBB) / CCC - SIG * U[I - 1]) / P;
end;
If YPN > 9.9E+29 Then
begin
QN:=0;
UN:=0;
end
Else
begin
QN:=0.5;
AAA:=YPN - (Y[N] - Y[N - 1]) / (X[N] - X[N - 1]);
UN:=(3 / (X[N] - X[N - 1])) * AAA;
end;
Y2[N]:=(UN - QN * U[N - 1]) / (QN * Y2[N - 1] + 1);
For K:=N - 1 DownTo 1 do
Y2[K]:=Y2[K] * Y2[K + 1] + U[K];
end;
procedure SPLINT(XA, YA, Y2A:array of real; N:integer; X:real;var Y:real);
label 1;
var
K,KLO,KHI:integer;
H,A,B,AAA,BBB,Q,QQ:real;
begin
KLO:=1;
KHI:=N;
1: If KHI - KLO > 1 Then
begin
K:=(KHI + KLO) Div 2;
If XA[K] > X Then
KHI:=K
Else
KLO:=K;
GoTo 1;
end;
H:=XA[KHI] - XA[KLO];
If H = 0 Then
begin
ShowMessage(' PAUSE "BAD XA INPUT');
Exit;
end;
A:=(XA[KHI] - X) / H;
B:=(X - XA[KLO]) / H;
AAA:=A * YA[KLO] + B * YA[KHI];
if A = 0 then
Q:= 0
else
if A > 0 then
Q:= exp(3*ln(A))
else
Q:= -EXP(3*LN(-A));
if B = 0 then
QQ:= 0
else
if B > 0 then
QQ:= exp(3*ln(B))
else
QQ:= -EXP(3*LN(-B));
BBB:=(Q - A) * Y2A[KLO] + (QQ - B) * Y2A[KHI];
Y:=AAA + BBB * (H * H) / 6;
end;
procedure SPLIE2(X1A, X2A:array of real; YA:matrx2;
M, N:integer;var Y2A:matrx2);
var
YTMP, Y2TMP:array[0..100] of real;
J,K:integer;
begin
For J:= 1 To M do
begin
For K:= 1 To N do
YTMP[K]:= YA[J, K];
SPLINE(X2A, YTMP, N, 1E+30, 1E+30, Y2TMP);
For K:= 1 To N do
Y2A[J, K]:= Y2TMP[K];
end;
end;
procedure SPLIN2(X1A, X2A:array of real; YA, Y2A:matrx2;
M, N:integer;var X1, X2, Y:real);
var
YTMP,Y2TMP,YYTMP:array[0..100] of real;
J,K:integer;
begin
For J:= 1 To M do
begin
For K:= 1 To N do
begin
YTMP[K]:= YA[J, K];
Y2TMP[K]:= Y2A[J, K];
end;
SPLINT(X2A, YTMP, Y2TMP, N, X2, YYTMP[J]);
end;
SPLINE(X1A, YYTMP, M, 1E+30, 1E+30, Y2TMP);
SPLINT(X1A, YYTMP, Y2TMP, M, X1, Y);
end;
end.
