我需要一些建议

时间:2021-04-04 14:01:50

标签: pascal numerical-methods runge-kutta

不明白代码哪里出错了,老师写的是“区间(1,3)没有根,在程序中找错误。”我需要你的帮助来指出我的错误在哪里。因为我真的已经在这个任务中受苦了,如果你能帮忙,我将不胜感激。

<块引用>

任务

  1. 编写一个程序:
  • a) 从点 1 中找到的隔离区间中找到给定非线性方程的 k 最小正根,精度为 0.001:除以一半(如果您的姓氏以元音字母开头),和弦(如果您的姓氏以辅音字母开头);
  • b) 在区间 [0; 2](要达到指定的精度,使用双转换法,取解的初始步长等于1);
  • c) 使用基于 b) 点微分方程解的线性插值,它找到函数在点处的近似值;
  • d) 通过以下方法确定单位电阻在 2 个单位时间内释放的热量:辛普森(如果您的名字以元音字母开头),梯形(如果您的名字以辅音字母开头) 0.1。
type

 Arr = array[0..100] of Real;

function f(x: Real): Real;

var
  x2: Real;
begin
  x2 := Sqr(x);
  f := 3 * Sqr(x2) + 8 * x2 * x + 6 * x2 - 10;
end;
function f1(x: Real): Real;
var
  x2: Real;
begin
  x2 := Sqr(x);
  f1 := 12 * x2 * x + 24 * x2 + 12 * x;
end;
function f2(x: Real): Real;
begin
  f2 := 36 * Sqr(x) + 48 * x + 12;
end;

function Solution(a, b, e: Real; var it: Integer): Real;
var
  x, g: Real;
begin
  if f(a) * f2(a) > 0 then begin
    x := b;
    g := a;
  end
  else begin
    x := a;
    g := b;
  end;
  it := 0;
  repeat
    x := x - f(x) * (g - x) / (f(g) - f(x));    
    Inc(it);
  until Abs(f(x)) <= e;
  Solution := x;
end;

function Fp(x, y: Real): Real;
begin
  Fp := 1-sin(3*x + y)+(y/(2+x));
end;
procedure Runge(x: Arr; var y: Arr; n: Integer);
var
  h: Real;
  k1, k2, k3, k4: Real;
  i: Integer;
begin
  h := x[1] - x[0];
  for i := 1 to n do begin
    k1 := Fp(x[i - 1], y[i - 1]);
    k2 := Fp(x[i - 1] + h / 2, y[i - 1] + h / 2 * k1);
    k3 := Fp(x[i - 1] + h / 2, y[i - 1] + h / 2 * k2);
    k4 := Fp(x[i - 1] + h, y[i - 1] + h * k3);
    y[i] := y[i - 1] + h / 6 * (k1 + 2 * k2 + 2 * k3 + k4);
  end;
end;

procedure LinInt(x, y, xIp: Arr; var yIp: Arr; n, nIp: Integer);
var 
  i, j: Integer;
  q, h: Real;
begin
  h := x[1] - x[0];
  for i := 0 to nIp do begin
    j := 0;
    while (j < n) and (x[j] <= xIp[i]) do
      Inc(j);
    Dec(j);
    q := (xIp[i] - x[j]) / h;
    yIp[i] := y[j] + q * (y[j + 1] - y[j]);
  end;
end;
function Trap(a, b: Real; y: Arr; n: Integer): Real;
var
  h: Real;
  i: Integer;
  sum: Real;
begin
  h := (b - a) / n;
  sum := 0;
  for i := 1 to n - 1 do
    sum := sum + y[i];
  Trap := h * ((y[0] + y[n]) / 2 + sum);
end;

const
  e = 0.0001;
  e4 = 15 * e;
  x0 = 0;
  a = 0;
  b = 2;
  hIp = 0.1; 
var
  y0: Real;
  it: Integer; 
  n: Integer;
  x, y: Arr;
  h: Real; 
  _n: Integer; 
  _x, _y: Arr;
  _h: Real; 
  nIp: Integer; 
  xIp, yIp: Arr;
  ok: Boolean;
  i: Integer;
begin
  y0 := Solution(0.5, 3, 0.001, it);
  Writeln('k  = ', y0:5:3, ' (iterations= ', it, ')');

  x[0] := x0;
  y[0] := y0;  
  _x[0] := x0;
  _y[0] := y0;  
  _n := 1;
  repeat
    _n := _n * 2;
    _h := (b - a) / _n;
    for i := 1 to _n do
      _x[i] := _x[i - 1] + _h;
    Runge(_x, _y, _n); 
    n := _n * 2;
    h := _h / 2;
    for i := 1 to n do
      x[i] := x[i - 1] + h;
    Runge(x, y, n); 
    ok := True;
    for i := 1 to _n do 
      if Abs(_y[i] - y[i * 2]) > e4 then begin
        ok := False;
        Break;
      end;
  until ok;
  Writeln('Results of solving the differential equation:');
  for i := 0 to n do begin
    Writeln('x = ', x[i]:8:4, '  y = ', y[i]:8:4);
    if (i = 20) or (i = 44) then
      Readln;
  end;
  Readln;
  nIp := Trunc((b - a) / hIp);
  xIp[0] := a;
  for i := 1 to nIp do
    xIp[i] := xIp[i - 1] + hIp;
  LinInt(x, y, xIp, yIp, n, nIp);
  Writeln('Results of interpolations:');
  for i := 0 to nIp do begin
    Writeln('x = ', xIp[i]:8:4, ' y = ', yIp[i]:8:4);
    yIp[i] := Sqr(yIp[i]);
  end;
  Writeln('Amount of heat Q=', Trap(a, b, yIp, nIp):8:4);
  Readln;
end.

0 个答案:

没有答案
相关问题