Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.10.24;
Скачать: CL | DM;

Вниз

Помогите найти пример RKF45   Найти похожие ветки 

 
Zvrb   (2004-10-11 11:09) [0]

Нигде не могу найти исходник RKF45, желатьельно на Pascal, но принимается всё что есть... даже фортран.
А может есть другие методы решения систем дифуров?


 
Zvrb   (2004-10-11 11:49) [1]

Вот нашёл код... но как его изминить под свои уравнения?

(************************************************
Этот модуль сгенерирован транслятором AlgoPascal.
************************************************)
uses Math, Ap;

(*
Эти подпрограммы должен определить программист:
function F(I : Integer; X : Double; Y : TReal1DArray):Double;
*)

procedure SystemRungeKutt(x : Double;
    x1 : Double;
    m : Integer;
    n : Integer;
    var y : TReal1DArray);forward;
procedure SystemRungeKuttStep(x : Double;
    h : Double;
    n : Integer;
    var y : TReal1DArray);forward;

(*************************************************************************
Метод Рунге-Кутта четвертого порядка для решения
системы дифферециальных уравнений.

procedure SystemRungeKutt(
   const   x   :   Real;
   const   x1  :   Real;
   const   m   :   Integer;
   const   n   :   Integer;
   var     y   :   array of Real);

Алгоритм решает систему диффуров y[i]"=F(i,x,y) для i=1..n
методом Рунге-Кутта 4 порядка.

Начальная точка имеет кординаты (x,y[1], ..., y[n])

До конечной точки мы добираемся через n промежуточных
с постоянным шагом h=(x1-x)/m

Результат помещается в переменную y
*************************************************************************)
procedure SystemRungeKutt(x : Double;
    x1 : Double;
    m : Integer;
    n : Integer;
    var y : TReal1DArray);
var
   h : Double;
   i : Integer;
begin
   I:=0;
   while I<=M-1 do
   begin
       SystemRungeKuttStep(x+I*(x1-x)/m, (x1-x)/m, n, y);
       Inc(I);
   end;
end;

(*************************************************************************
Один шаг метода Рунге-Кутта четвертого порядка для решения
системы дифферециальных уравнений.

procedure SystemRungeKuttStep(
   const   x   :   Real;
   const   h   :   Real;
   const   n   :   Integer;
   var     y   :   array of Real);

Алгоритм совершает один шаг метода для системы
диффуров y[i]"=F(i,x,y) для i=1..n

Начальная точка имеет кординаты (x,y[1], ..., y[n])

После выполнения алгоритма в переменной y содержится состояние
системы в точке x+h
*************************************************************************)
procedure SystemRungeKuttStep(x : Double;
    h : Double;
    n : Integer;
    var y : TReal1DArray);
var
   I : Integer;
   yt : TReal1DArray;
   k1 : TReal1DArray;
   k2 : TReal1DArray;
   k3 : TReal1DArray;
   k4 : TReal1DArray;
label __Finalizing;
begin
   //Initializers
   yt := TReal1DArray.Create;
   k1 := TReal1DArray.Create;
   k2 := TReal1DArray.Create;
   k3 := TReal1DArray.Create;
   k4 := TReal1DArray.Create;

   //Body
   yt.SetBounds(1, N);
   k1.SetBounds(1, N);
   k2.SetBounds(1, N);
   k3.SetBounds(1, N);
   k4.SetBounds(1, N);
   I:=1;
   while I<=N do
   begin
       k1[i] := h*F(i, x, y);
       Inc(I);
   end;
   i:=1;
   while i<=n do
   begin
       yt[i] := y[i]+0.5*k1[i];
       Inc(i);
   end;
   I:=1;
   while I<=N do
   begin
       k2[i] := h*F(i, x+h*0.5, yt);
       Inc(I);
   end;
   i:=1;
   while i<=n do
   begin
       yt[i] := y[i]+0.5*k2[i];
       Inc(i);
   end;
   I:=1;
   while I<=N do
   begin
       k3[i] := h*F(i, x+h*0.5, yt);
       Inc(I);
   end;
   i:=1;
   while i<=n do
   begin
       yt[i] := y[i]+k3[i];
       Inc(i);
   end;
   I:=1;
   while I<=N do
   begin
       k4[i] := h*F(i, x+h, yt);
       Inc(I);
   end;
   i:=1;
   while i<=n do
   begin
       y[i] := y[i]+(k1[i]+2.0*k2[i]+2.0*k3[i]+k4[i])/6;
       Inc(i);
   end;

   //Finalizers
__Finalizing:
   yt.Destroy;
   k1.Destroy;
   k2.Destroy;
   k3.Destroy;
   k4.Destroy;
end;



Страницы: 1 вся ветка

Текущий архив: 2004.10.24;
Скачать: CL | DM;

Наверх




Память: 0.48 MB
Время: 0.022 c
14-1096545021
1008
2004-09-30 15:50
2004.10.24
Существует ли возможность изменить цвет заголовка у TabSheet?


3-1095938546
Nick-From
2004-09-23 15:22
2004.10.24
TDBComboBox не дает выбирать значения


3-1096265469
YurikGL
2004-09-27 10:11
2004.10.24
tpb Constant () is unknown


8-1090928361
П7
2004-07-27 15:39
2004.10.24
Как заставить Flash перерисовывать себя при отображении


4-1095769119
3DiMaN
2004-09-21 16:18
2004.10.24
как послать строку в com-порт