Полет тела, брошенного под углом к горизонту - Pascal ABC

Формулировка задачи:

Реализация модели «Полет тела, брошенного под углом к горизонту» Помогите,пожалуйста, переделать код на Паскаль ABC.

Program Pod Uglom;
Uses Crt, Graph;
Type G = Array[1..4] Of Real;
Const A = 0; В =0.1; (параметры модели) 
Al = Pi / 4; (угол - параметр модели} 
Н = 0.001; Нрr = 0.1; (шаг интегрирования и шаг вывода результатов)
Var N, I, J, M, L, К : Integer;
Y0, Y : G; Х0, X, Xpr, A1, B1, Cosinus, Sinus : Real; LS : String;
Function Ff(I : Integer; X : Real; Y : G) : Real;
{описание правых частей дифференциальных уравнений} 
Begin
Case I Of
1: Ff:=-A1*Sinus*Y[l]-Bl*Sinus*Sqrt(Sqr(Y(l])+Sqr(Y[2]))*Y[1];
2: Ff:=-Sinus-A1*Sinus*Y[1]-B1*Sinus*Sqrt(Sqr(Y(1])+Sqr(Y[2]))*Y[2];
3: Ff:=Y[1]/(2*Cosinus);
4: Ff:=2*Y[2]/Sinus
End 
End;
Procedure Runge_Kut (N: Integer; Var X: Real; Y0: G; Var Y: G; Н: Real);
(метод Рунге-Кутта четвертого порядка)
Var I : Integer; Z, K1, K2, КЗ, К4 : G;
Procedure Right(X : Real; Y : G; Var F : G) ;
{вычисление правых частей дифференциальных уравнений}
Var I : Integer;
Begin
For I := 1 To N Do F[I] := Ff(I, X, У)
  End;
Begin Right(X, Y0, K1); X := X + Н / 2;
 For I := 1 To N Do Z[I]:=Y0[I]+H*K1[I]/2; Right(X, Z, K2);
For I := 1 To N Do Z[I]:=YO[I]+H*K2[I]/2; Right(X, Z, КЗ); Х:=Х+Н/2;
For I := 1 To N Do Z[I] := Y0[I] + H * КЗ [I]; Right (X, Z, К4);
For I := 1 To N Do
Y[I]:=Y0[I]+H*(K1[I]+2*K2[I]+2*K3[I]+K4[I])/6;
End;
{следующий блок - для получения численных результатов при одном наборе параметров} 
Begin
Sinus := Sin(Al); Cosinus := Cos(Al); Al := A; Bl := B; ClrScr;
N:=4; X0:=0; Y0[l]:=Cosinus; Y0[2]:=Sinus; Y0[3]:=0; Y0[4]:=0;
WriteLn(' время скорость координаты');
WriteLn; X := Х0; Xpr := 0; Y[4] := Y0[4];
While Y[4] >= 0 Do
Begin
If X >= Xpr Then
Begin
WriteLn ('t=', X : 6 : 3, ' Vx='. Y0[l] : 6 : 3, ' Vy=',
Y0[2] : 6 : 3. ' X=', y0[3] : 6 : 3, ' Y=', Y0[4] : б : 3) ;
Xpr := Xpr + Hpr 
End;
Runge_Kut(N, X, Y0, Y, H); Y0 := Y 
End;
WriteLn; WriteLn('для продолжения нажмите любую клавишу');
Repeat Until KeyPressed 
End.}
{следующий блок - для изображения траекторий при нескольких наборах параметров} 
Begin
DetectGraph (J, M); InitGraph (J, M, '');
L := 1; Al := A; Bl := В; Sinus := Sin(Al); Cosinus := Cos(Al);
While L < 5 Do 
Begin
N := 4; (Количество уравнений в системе)
Х0 := 0; Y0[l] := Cosinus; (Начальные условия}
Y0[2] := Sinus; Y0[3] := 0; Y0[4] := 0:
SetColor(L); Line(400, 50 + 20 * (L - 1), 440, 50 + 20 * (L - 1));
OutTextXY(450, 50 + 20 * (L - 1), '1 = ');
   Str(L, LS); OutTextXY(480, 50+20*(L-l), LS); X:=X0; Y[4]:=Y0[4];
While Y[4] >= 0 Do 
     Begin 
Runge_Kut(N, X, Y0, Y, H); Y0 := Y;
     PutPixel(Abs(Trunc(Y0[3]*500)), GetMaxY-Abs(Trunc(Y0[4]*500)), L) ;
End;    
   Bl := Bl * 10; L := L + 1 
End;
OutTextXY(10, 50, 'для продолжения нажмите любую клавишу');
Repeat Until KeyPressed; CloseGraph
End.

Решение задачи: «Полет тела, брошенного под углом к горизонту»

Листинг программы

Program PodUglom;
Uses Crt, GraphABC;
Type G = Array[1..4] Of Real;
Const
A = 0;
B =0.1; {ГЇГ*Г°Г*Г¬ГҐГІГ°Г» Г¬Г®Г¤ГҐГ«ГЁ}
Al = Pi / 4; {ГіГЈГ®Г« - ГЇГ*Г°Г*Г¬ГҐГІГ° Г¬Г®Г¤ГҐГ«ГЁ}
H = 0.001;
Hpr = 0.1; {ГёГ*ГЈ ГЁГ*ГІГҐГЈГ°ГЁГ°Г®ГўГ*Г*ГЁГї ГЁ ГёГ*ГЈ ГўГ»ГўГ®Г¤Г* Г°ГҐГ§ГіГ«ГјГІГ*ГІГ®Гў}
Var N, I, J, M, L, K : Integer;
Y0, Y : G; X0, X, Xpr, A1, B1, Cosinus, Sinus : Real; LS : String;
Function Ff(I : Integer; X : Real; Y : G) : Real; {Г®ГЇГЁГ±Г*Г*ГЁГҐ ГЇГ°Г*ГўГ»Гµ Г·Г*Г±ГІГҐГ© Г¤ГЁГґГґГҐГ°ГҐГ*Г¶ГЁГ*Г«ГјГ*Г»Гµ ГіГ°Г*ГўГ*ГҐГ*ГЁГ©}
Begin
Case I Of
1: Ff:=-A1*Sinus*Y[l]-B1*Sinus*Sqrt(Sqr(Y[1])+Sqr(Y[2]))*Y[1];
2: Ff:=-Sinus-A1*Sinus*Y[1]-B1*Sinus*Sqrt(Sqr(Y[1])+Sqr(Y[2]))*Y[2];
3: Ff:=Y[1]/(2*Cosinus);
4: Ff:=2*Y[2]/Sinus;
End;
End;
Procedure Runge_Kut (N: Integer; Var X: Real; Y0: G; Var Y: G; ГЌ : Real); {Г¬ГҐГІГ®Г¤ ГђГіГ*ГЈГҐ-ГЉГіГІГІГ* Г·ГҐГІГўГҐГ°ГІГ®ГЈГ® ГЇГ®Г°ГїГ¤ГЄГ*}
Var I : Integer; Z, K1, K2, ГЉГ‡, ГЉ4 : G;
Procedure Right(X : Real; Y : G; Var F : G) ; {ГўГ»Г·ГЁГ±Г«ГҐГ*ГЁГҐ ГЇГ°Г*ГўГ»Гµ Г·Г*Г±ГІГҐГ© Г¤ГЁГґГґГҐГ°ГҐГ*Г¶ГЁГ*Г«ГјГ*Г»Гµ ГіГ°Г*ГўГ*ГҐГ*ГЁГ©}
Var I : Integer;
Begin
For I := 1 To N Do F[I] := Ff(I, X, Г“);
End;
Begin Right(X, Y0, K1); X := X + ГЌ / 2;
For I := 1 To N Do Z[I]:=Y0[I]+H*K1[I]/2; Right(X, Z, K2);
For I := 1 To N Do Z[I]:=YO[I]+H*K2[I]/2; Right(X, Z, ГЉГ‡); Г•:=Г•+ГЌ/2;
For I := 1 To N Do Z[I] := Y0[I] + H * ГЉГ‡ [I]; Right (X, Z, ГЉ4);
For I := 1 To N Do
Y[I]:=Y0[I]+H*(K1[I]+2*K2[I]+2*K3[I]+K4[I])/6;
End; {Г±Г«ГҐГ¤ГіГѕГ№ГЁГ© ГЎГ«Г®ГЄ - Г¤Г«Гї ГЇГ®Г«ГіГ·ГҐГ*ГЁГї Г·ГЁГ±Г«ГҐГ*Г*Г»Гµ Г°ГҐГ§ГіГ«ГјГІГ*ГІГ®Гў ГЇГ°ГЁ Г®Г¤Г*Г®Г¬ Г*Г*ГЎГ®Г°ГҐ ГЇГ*Г°Г*Г¬ГҐГІГ°Г®Гў}
Begin
Sinus := Sin(Al); Cosinus := Cos(Al); Al := A; Bl := B; ClrScr;
N:=4; X0:=0; Y0[l]:=Cosinus; Y0[2]:=Sinus; Y0[3]:=0; Y0[4]:=0;
WriteLn(' ГўГ°ГҐГ¬Гї, Г±ГЄГ®Г°Г®Г±ГІГј ГЄГ®Г®Г°Г¤ГЁГ*Г*ГІГ»');
WriteLn; X := Г•0; Xpr := 0; Y[4] := Y0[4];
While Y[4] >= 0 Do
Begin
If X >= Xpr Then
Begin
WriteLn ('t=', X : 6 : 3, ' Vx='. Y0[l] : 6 : 3, ' Vy=',
Y0[2] : 6 : 3. ' X=', y0[3] : 6 : 3, ' Y=', Y0[4] : ГЎ : 3) ;
Xpr := Xpr + Hpr;
End;
Runge_Kut(N, X, Y0, Y, H); Y0 := Y ;
End;
WriteLn; WriteLn('Г¤Г«Гї ГЇГ°Г®Г¤Г®Г«Г¦ГҐГ*ГЁГї Г*Г*Г¦Г¬ГЁГІГҐ Г«ГѕГЎГіГѕ ГЄГ«Г*ГўГЁГёГі');
Repeat Until KeyPressed
End; {Г±Г«ГҐГ¤ГіГѕГ№ГЁГ© ГЎГ«Г®ГЄ - Г¤Г«Гї ГЁГ§Г®ГЎГ°Г*Г¦ГҐГ*ГЁГї ГІГ°Г*ГҐГЄГІГ®Г°ГЁГ© ГЇГ°ГЁ Г*ГҐГ±ГЄГ®Г«ГјГЄГЁГµ Г*Г*ГЎГ®Г°Г*Гµ ГЇГ*Г°Г*Г¬ГҐГІГ°Г®Гў}
Begin
DetectGraph (J, M); InitGraph (J, M, '');
L := 1; Al := A; Bl := Г‚; Sinus := Sin(Al); Cosinus := Cos(Al);
While L < 5 Do
Begin
N := 4; {ГЉГ®Г«ГЁГ·ГҐГ±ГІГўГ® ГіГ°Г*ГўГ*ГҐГ*ГЁГ© Гў Г±ГЁГ±ГІГҐГ¬ГҐ}
Г•0 := 0; Y0[l] := Cosinus; {ГЌГ*Г·Г*Г«ГјГ*Г»ГҐ ГіГ±Г«Г®ГўГЁГї}
Y0[2] := Sinus; Y0[3] := 0; Y0[4] := 0:
SetColor(L); Line(400, 50 + 20 * (L - 1), 440, 50 + 20 * (L - 1));
OutTextXY(450, 50 + 20 * (L - 1), '1 = ');
Str(L, LS); OutTextXY(480, 50+20*(L-l), LS); X:=X0; Y[4]:=Y0[4];
While Y[4] >= 0 Do
Begin
Runge_Kut(N, X, Y0, Y, H); Y0 := Y;
PutPixel(Abs(Trunc(Y0[3]*500)), GetMaxY-Abs(Trunc(Y0[4]*500)), L) ;
End;    
Bl := Bl * 10; L := L + 1;
End;
OutTextXY(10, 50, 'Г¤Г«Гї ГЇГ°Г®Г¤Г®Г«Г¦ГҐГ*ГЁГї Г*Г*Г¦Г¬ГЁГІГҐ Г«ГѕГЎГіГѕ ГЄГ«Г*ГўГЁГёГі');
Repeat Until KeyPressed; CloseGraph;
End.

Объяснение кода листинга программы

В начале кода объявлены переменные и константы:
- N, I, J, M, L, K - целочисленные переменные
- Y0, Y - массивы из 4 элементов для хранения значений функции
- X0, X, Xpr, A1, B1, Cosinus, Sinus - вещественные переменные
- LS - строковая переменная для хранения результата вычисления функции
- A, B, Al, Bl - константы с значениями 0, 0.1, Pi/4, 0.001 соответственно
Затем определена функция Ff, которая принимает два аргумента: I (целое число) и X (вещественное число), и возвращает вещественное число. Функция Ff используется в процедуре Runge_Kut.
Процедура Runge_Kut принимает три аргумента: N (целое число), X (вещественное число) и Y0 (массив из 4 элементов). Она использует функцию Ff для вычисления значений функции на каждом шаге и обновления массива Y.
В основной части кода определены начальные значения переменных, включая значения функции Y0 и X0. Затем происходит итерационный процесс, в котором значения функции Y обновляются с помощью процедуры Runge_Kut.
В процессе итераций значение переменной Y[4] уменьшается от 0 до 0, и когда оно достигает 0, процесс итераций завершается.
После завершения итераций выводится график функции с помощью процедуры DetectGraph и InitGraph. График рисуется с помощью функции Line и OutTextXY.
В конце кода выводится строка Г¤Г«Гї ГЇГ°Г®Г¤Г®Г«Г¦ГҐГ*ГЁГї Г*Г*Г¦Г¬ГЁГІГҐ Г«ГѕГЎГіГѕ ГЄГ«Г*ГўГЁГёГі, которая представляет собой график функции.
Код повторяется до тех пор, пока не будет нажата клавиша, и завершается с помощью функции CloseGraph.