Додаток

program Project_ODU1

program Project_ODU1;

{$APPTYPE CONSOLE}

Uses Math, sysutils, classes, Dialogs, MyType, MyPr;

var

i,j,z,m,Im,Jm,Nz,Kpol,Kn,L,C : Ir;

T,X : Vec;

A,Tp,Xp,Y,YY,Yp,YYp,MB,R : VecSh;

MA,MATR : Mat;

AA,K,Y0,S : Db;

F1,F2 : TextFile;

Begin

AssignFile(F1,'Input_ODU1.txt');

AssignFile(F2,'Output_ODU1.txt');

Reset(F1);

ReWrite(F2);

Readln(F1,Kpol,Jm,AA,K,Y0);

Readln(F1,Im);

Writeln(F2,' A=',AA:10:5,' K=',K:10:5,' Y0=',Y0:10:5);

Writeln(F2,' Im=',Im:3,' Kpol=',Kpol:2,' Jm=',Jm:3);

Writeln(' A=',AA:10:5,' K=',K:10:5,' Y0=',Y0:10:5);

Writeln(' Im=',Im:3,' Kpol=',Kpol:2,' Jm=',Jm:3);

Readln;

for i:=0 to Im do Readln(F1,T[i], X[i]);

Writeln(F2,' i T X');

Writeln(' i T X');

for i:=0 to Im do Writeln(F2,i:3,T[i]:10:5,X[i]:10:5);

for i:=0 to Im do Writeln(i:3,T[i]:10:5,X[i]:10:5);

Readln;

Nz:=(Im Div Jm)-1;

a[0]:=Y0;

for z:=0 to Nz do

begin

for j:=0 to Jm do

begin

i:=z*Jm+j;

Tp[j]:=T[i]-T[z*Jm];

Xp[j]:=X[i];

end;

Matrix(Kpol,Jm,Tp,AA,MA);

Vector(Kpol,Jm,Tp,Xp,a[0],AA,K,MB);

Kn:=Kpol-1;

for L:=0 to Kn do

for C:=0 to Kn do MATR[L,C]:=MA[L,C];

for L:=0 to Kn do MATR[L,Kpol]:=MB[L];

Gauss(Kpol,MATR,R,S);

for i:= 0 to Kn do

begin

m:=i+1;

a[m]:=R[i];

end;

for j:=0 to Jm do

begin

Yp[j]:=a[0];

YYp[j]:=0;

for m:=1 to Kpol do

begin

Yp[j]:=Yp[j]+a[m]*Power(Tp[j],m);

YYp[j]:=YYp[j]+m*a[m]*Power(Tp[j],m-1);

end;

Y[z*Jm+j]:=Yp[j];

YY[z*Jm+j]:=YYp[j];

end;

a[0]:=Yp[Jm];

end;

Writeln(F2,'Rezalt');

Writeln(F2,' i T X Y YY');

Writeln(' i T X Y YY');

for i:=0 to Nz*(Jm+1) do

begin

Writeln(F2,i:3,T[i]:10:5,X[i]:10:5,Y[i]:10:5,YY[i]:10:5);

Writeln(i:3,T[i]:10:5,X[i]:10:5,Y[i]:10:5,YY[i]:10:5);

end;

Readln;

Close(F1);

Close(F2);

END.

unit MyPr

unit MyPr;

interface

uses MyType, SysUtils, Classes, Math;

procedure Gauss(N:Ir; A:Mat; var X:VecSh; var S:Db);

procedure Gram(N:Ir; var A:Mat; var X,Y:VecSh; var M,K:Ir);

procedure Matrix(Kpol,Jm:Ir; T:VecSh; A:Db; var MA:Mat);

procedure Vector(Kpol,Jm:Ir; T,X:VecSh; Y0,A,K:Db; var MB:VecSh);

procedure Aprox(Kpol,Jm:Ir; T,Xp:VecSh; var B:VecSh;

var Xa,XXa:VecSh; var R2X:Db);

procedure Anl_ODU1(A,K,Y0:Db; Nz,Kpol:Ir; ak:VecSh; T:Vec; var Y:Vec);

implementation

procedure Gauss(N:Ir; A:Mat; var X:VecSh; var S:Db);

var

I,J,K,K1,N1 : Ir;

R : Db;

begin

N1:=N+1;

for K:=0 to N-1 do begin

K1:=K+1;

S:=A[K,K];

J:=K;

for I:=K1 to N-1 do begin

R:=A[I,K];

if Abs(R) > Abs(S) then begin

S:=R;

J:=I;

end;

end;

if J<> K then

for I:=K to N1-1 do begin

R:=A[K,I];

A[K,I]:=A[J,I];

A[J,I]:=R

end;

for J:=K1 to N1-1 do A[K,J]:=A[K,J]/S;

for I:=K1 to N-1 do begin

R:=A[I,K];

for J:=K1 to N1-1 do A[I,J]:=A[I,J]-A[K,J]*R;

end;

end;

// if S<>0.0 then

for I:=N-1 downto 0 do begin

S:=A[I,N1-1];

for J:=I+1 to N-1 do S:=S-A[I,J]*X[J];

X[I]:=S;

end;

end;

procedure Gram(N:Ir; var A:Mat; var X,Y:VecSh; var M,K:Ir);

var

I1,Pp,I,J,L : Ir;

S : Db;

Begin

M:=K+1;

for I:=0 to M-1 do

begin

for J:=0 to M-1 do

begin

S:=0.0; Pp:=I+J;

for L:=1 to N do S:=S+Power(X[L],Pp);

A[I,J]:=S;

end;

I1:=I;

S:=0.0;

for L:=1 to N do S:=S+Y[L]*Power(X[L],I1);

A[I,M]:=S;

end;

End;

procedure Matrix(Kpol,Jm:Ir; T:VecSh; A:Db; var MA:Mat);

var

j,L,C,Kn : Ir;

Begin

try

Kn:=Kpol-1;

for L:=0 to Kn do

for C:=0 to Kn do begin

MA[L,C]:=0;

for j:=0 to Jm do

MA[L,C]:=MA[L,C]+(A*(C+1)*Power(T[j],C)+

Power(T[j],C+1))*(A*(L+1)*Power(T[j],L)+Power(T[j],L+1));

end;

except

on e:Exception do begin

writeln(E.Message);

readln;

end;

end;

end;

procedure Vector(Kpol,Jm:Ir; T,X:VecSh; Y0,A,K:Db; var MB:VecSh);

var

j,L,Kn : Ir;

Begin

Kn:=Kpol-1;

for L:=0 to Kn do

begin

MB[L]:=0;

for j:=0 to Jm do

MB[L]:=MB[L]+(K*X[j]-Y0)*(A*(L+1)*Power(T[j],L)+Power(T[j],L+1));

end;

End;

procedure Aprox(Kpol,Jm:Ir; T,Xp:VecSh; var B:VecSh;

var Xa,XXa:VecSh; var R2X:Db);

var

M,K,J : Ir;

S,S1,S2,S3 : Db;

R : VecSh;

Ag : Mat;

Begin

Gram(Jm,Ag,T,Xp,M,Kpol);

Gauss(M,Ag,R,S);

For K:=0 to Kpol do B[K]:=R[K];

For J:=0 to Jm do

begin

Xa[J]:=0;

XXa[J]:=0;

For K:=0 to Kpol do Xa[J]:=Xa[J]+B[K]*Power(T[J],K);

For K:=1 to Kpol do XXa[J]:=XXa[J]+K*B[K]*Power(T[J],K-1);

end;

S1:=0;

S2:=0;

S3:=0;

For J:=1 to Jm do

begin

S1:=S1+Sqr(Xp[J]-Xa[J]);

S2:=S2+Sqr(Xp[J]);

S3:=S3+Xp[J];

end;

R2X:=1-S1/(S2-Sqr(S3)/Jm);

End;

procedure Anl_ODU1(A,K,Y0:Db; Nz,Kpol:Ir; ak:VecSh; T:Vec; var Y:Vec);

Var i,kn : Ir;

Ck : VecSh;

Begin

Ck[Kpol]:=K*ak[Kpol];

for kn:=Kpol-1 downto 0 do Ck[kn]:=K*ak[kn]-(kn+1)*A*Ck[kn+1];

for i:=0 to Nz do

begin

Y[i]:=(Y0-Ck[0])*exp(-T[i]/A);

for kn:= 0 to Kpol do Y[i]:=Y[i]+Ck[kn]*power(T[i],kn);

end;

End;

end.

unit MyType

unit MyType;

interface

type

Ir = Integer;

Db = Double;

Vec = array[0..200] of Double;

VecSh = array[0..50] of Double;

Mat = array[0..20,0..21] of Double;

implementation

end.

36