Консультация № 198506
10.05.2020, 14:00
0.00 руб.
0 3 0
Здравствуйте, помогите, пожалуйста, исправить ошибку (неправильные параметры программы)
Код:

const
y0 = 0.25; n = 5;
nt = 10;
nl = 4;hl = 5;
epsilon = 0.000001; x0 = 2;


type
mass = array[0..2*nl] of real;

var
x, y: array [0..2 * nt] of real;
T, h: real;

Xl, Yl:mass;
kl, kolit: integer;
tl, zl: real;
fp, ft,filerez: text;
tx: string;

function polynom(t: real): real;
begin
polynom := 2 * (t * t * t * t) - t * t * t - 8;
end;

function phi(x:real):real;
begin
phi:=x+polynom(x);
end;

procedure Iter(a,b:real;var x2,y2:real; var flag:Boolean);
var
x0,x1,y0,y1:real;
begin
kolit:=kolit+1;
x0:=a;y0:=phi(x0);
x1:=b;y1:=phi(x1);
x2:=(x1*y0-y1*x0)/((x1-x0)-(y1-y0));
y2:=phi(x2);
flag:=(y0-x0)*(y2-x2)>0;
end;

procedure Vegstein(a,b,eps:real; var x:real);
var
xz,yz:real;
prizn:Boolean;
begin
repeat
Iter(a,b,xz,yz,prizn);
if prizn then a:=xz else b:=xz;
until abs(xz - yz) < eps;
writeln('корень===',xz);
x:=xz;
end;


function Fs(x, t: real): real;
begin
if x > t then x := x - t * (trunc(x / t));
if (x > 0) and (x < 1) then
result := 1
else if (x >= 1) and (x <= t) then
result := (t - x) / (t - 1);

end;

function f(x, y: real): real;
begin
result := 0.1*x*x - 2*x*y + (1+n/10) * Fs(x, T)
end;

function Euiler(x0,y0,h:real):real;
begin
Euiler:=y0+h*F(x0,y0);
end;
//procedure Integr(x0,y0,h:real;nt:integer;var V,U:mass);
{входные параметры x0,y0- начальные условия в задаче Коши}
{h- шаг интегрирования, N- число точек интегрирования}
{V –дискретные значения аргумента}
{U- численные значения решения диф. уравнения }
procedure Integr(x0,y0,h:real;N:integer;var V,U:mass);
{входные параметры x0,y0- начальные условия в задаче Коши}
{var
j:integer;
begin
x[0]:=x0;y[0]:=y0;
for j:=1 to nt do
begin
x[j]:=x0+j*h;
y[j]:=Euiler(x[j-1],y[j-1],h);
writeln(j,x[j],y[j]);
end;
end;}
var
j:integer;
begin
V[0]:=x0;U[0]:=y0;
for j:=1 to N do
begin
V[j]:=x0+j*h;
U[j]:=Euiler(V[j-1],U[j-1],h);
writeln(j,V[j],U[j]);
end;
end;
{============================================= }
procedure minmax(nt:integer;A:mass;var maxA,minA:real);
{вычисление наиб и наим значений в массиве}
var
j:integer;
begin
maxA:=A[0];minA:=A[0];
for j:=1 to N do
begin
if A[j]> maxA then maxA:=A[j];
if A[j]< minA then minA:=A[j];
end;
writeln('max=',maxA:10:28,'min=':10,minA:10:4);
end;
{================================================}
function discret(t:real):real;{превращение дискретной функции}
{ в функцию непрерывного аргумента для сеточной функции}
{ вчисленной в N точках равномерной сетки с шагом Hint на [0, T] }
{и заданной в массиве U- глобальном в процедуре }
begin
discret:=y[round(t/h)];

end;
{в раздел операторов: после вычисления корня уравнения }
{++++++++++++++++++++++++++++++++++++++++++++++++++++}



function Lagrange(nl: integer; Xl, Yl: mass; tl: real): real;
var
p, z: real;
k, j: integer;
begin
z := 0;
for k := 0 to nl do
begin
p := 1;
for j := 0 to nl do
begin
if k <> j then
p := p * (tl - Xl[j]) / (Xl[k] - Xl[j]);
end;
z := z + Yl[k] * p;
end;
Lagrange := z;
end;


begin
assign(fp, 'out_eiler.txt');
rewrite(fp);

Vegstein(1, 3, epsilon, T);
h := T / nt;
writeln;
//h:=2*T/n;{шаг интегрирования}

{=================интегрирование====================}
Integr(x0,y0,h,nt,X,Y);
{========запись данных в файл==============}
assign(filerez,'c:\work\rezult');
rewrite(filerez);
for j:=0 to nt do
writeln(filerez,j:4,' ',x[j]:10:2,y[j]:12:-2);
close(filerez);

writeln('Lagrange points:');
for kl := 0 to nl do
begin
xl[kl] := X[kl * 5];yl[kl] := Y[kl * 5];
writeln(xl[kl]:10:3, yl[kl]:10:3);
end;
writeln;

writeln('Lagrange:');
for kl := 0 to 19 do
begin
tl := xl[0] + ((xl[nl] - xl[0]) * kl / 19);
zl := Lagrange(nl, Xl, Yl, tl);
writeln(tl:9:4, zl:14:6);
end;

close(fp);
end.

Обсуждение

давно
Посетитель
403898
18
10.05.2020, 14:09
общий
Условие задания. На первом этапе выполнения задания решается нелинейное уравнение метод Вегстейна. Корень уравнения определяет интервал интегрирования дифференциального уравнения, решаемого на втором этапе задания. Здесь задача Коши решается методами интегрирования второго порядка: по средней производной. На третьем этапе строится полином Лагранжа, интерполирующий дискретные значения на разреженной сетке узлов.
давно
Старший Модератор
31795
6196
10.05.2020, 20:44
общий
Адресаты:
Ваш код нормально скомпилируется всеми, кроме ВР и ТР
Об авторе:
Мне безразлично, что Вы думаете о обо мне, но я рад за Вас - Вы начали думать.

давно
Старший Модератор
31795
6196
13.05.2020, 20:59
общий
13.05.2020, 21:00
Адресаты:
Подправил код, компилируется и запускантся, но в вычислениях есть деление на ноль
[code lang=pascal h=400]const
y0 = 0.25;
n = 5;
nt = 10;
nl = 4;
hl = 5;
epsilon = 0.000001;
x0 = 2;

type
mass = array[0..2 * nt] of real;

var
x, y:mass;// array [0..2 * nt] of real;
T, h: real;

Xl, Yl: mass;
kl, kolit: integer;
tl, zl: real;
fp, ft, filerez: text;
tx: string;

function polynom(t: real): real;
begin
polynom := 2 * (t * t * t * t) - t * t * t - 8;
end;

function phi(x: real): real;
begin
phi := x + polynom(x);
end;

procedure Iter(a, b: real; var x2, y2: real; var flag: Boolean);
var
x0, x1, y0, y1: real;
begin
kolit := kolit + 1;
x0 := a; y0 := phi(x0);
x1 := b; y1 := phi(x1);
x2 := (x1 * y0 - y1 * x0) / ((x1 - x0) - (y1 - y0));
y2 := phi(x2);
flag := (y0 - x0) * (y2 - x2) > 0;
end;

procedure Vegstein(a, b, eps: real; var x: real);
var
xz, yz: real;
prizn: Boolean;
begin
repeat
Iter(a, b, xz, yz, prizn);
if prizn then a := xz else b := xz;
until abs(xz - yz) < eps;
writeln('корень===', xz);
x := xz;
end;

function Fs(x, t: real): real;
begin
if x > t then x := x - t * (trunc(x / t));
if (x > 0) and (x < 1) then
result := 1
else if (x >= 1) and (x <= t) then
result := (t - x) / (t - 1);

end;

function f(x, y: real): real;
begin
result := 0.1 * x * x - 2 * x * y + (1 + n / 10) * Fs(x, T)
end;

function Euiler(x0, y0, h: real): real;
begin
Euiler := y0 + h * F(x0, y0);
end;
//procedure Integr(x0,y0,h:real;nt:integer;var V,U:mass);
{входные параметры x0,y0- начальные условия в задаче Коши}
{h- шаг интегрирования, N- число точек интегрирования}
{V –дискретные значения аргумента}
{U- численные значения решения диф. уравнения }
procedure Integr(x0, y0, h: real; N: integer; var V, U: mass);
{входные параметры x0,y0- начальные условия в задаче Коши}
{var
j:integer;
begin
x[0]:=x0;y[0]:=y0;
for j:=1 to nt do
begin
x[j]:=x0+j*h;
y[j]:=Euiler(x[j-1],y[j-1],h);
writeln(j,x[j],y[j]);
end;
end;}
var
j: integer;
begin
V[0] := x0; U[0] := y0;
for j := 1 to N do
begin
V[j] := x0 + j * h;
U[j] := Euiler(V[j - 1], U[j - 1], h);
writeln(j:3,')', V[j]:15:10, U[j]:15:10);
end;
end;
{============================================= }
procedure minmax(nt: integer; A: mass; var maxA, minA: real);
{вычисление наиб и наим значений в массиве}
var
j: integer;
begin
maxA := A[0]; minA := A[0];
for j := 1 to N do
begin
if A[j] > maxA then maxA := A[j];
if A[j] < minA then minA := A[j];
end;
writeln('max=', maxA:10:28, 'min=':10, minA:10:4);
end;
{================================================}
function discret(t: real): real;{превращение дискретной функции}
{ в функцию непрерывного аргумента для сеточной функции}
{ вчисленной в N точках равномерной сетки с шагом Hint на [0, T] }
{и заданной в массиве U- глобальном в процедуре }
begin
discret := y[round(t / h)];
end;
{в раздел операторов: после вычисления корня уравнения }
{++++++++++++++++++++++++++++++++++++++++++++++++++++}
function Lagrange(nl: integer; Xl, Yl: mass; tl: real): real;
var
p, z: real;
k, j: integer;
begin
z := 0;
for k := 0 to nl do
begin
p := 1;
for j := 0 to nl do
begin
if k <> j then
p := p * (tl - Xl[j]) / (Xl[k] - Xl[j]);
// writeln(Xl[k],' - ',Xl[j]);
end;
// writeln(z);
z := z + Yl[k] * p;
end;
Lagrange := z;
end;

begin
assign(fp, 'out_eiler.txt');
rewrite(fp);
Vegstein(1, 3, epsilon, T);
h := T / nt;
writeln;
//h:=2*T/n;{шаг интегрирования}
{=================интегрирование====================}
Integr(x0, y0, h, nt, X, Y);
{========запись данных в файл==============}
assign(filerez, 'D:\CAT\_my\200513a.txt');
rewrite(filerez);
for var j := 0 to nt do
writeln(filerez, j:4, ' ', x[j]:10:2, y[j]:12:-2);
close(filerez);

writeln('Lagrange points:');
for kl := 0 to nl do
begin
xl[kl] := X[kl * 5]; yl[kl] := Y[kl * 5];
writeln(xl[kl]:10:6, yl[kl]:10:6);
end;
writeln;

writeln('Lagrange:');
for kl := 0 to 19 do
begin
tl := xl[0] + ((xl[nt] - xl[0]) * kl / 19);
zl := Lagrange(nt, Xl, Yl, tl);
writeln(tl:9:4, zl:14:6);
end;
close(fp);
end.[/code]
Об авторе:
Мне безразлично, что Вы думаете о обо мне, но я рад за Вас - Вы начали думать.

Форма ответа