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

@Ksenia S · Регистрация: 05.10.2013

Студворк — интернет-сервис помощи студентам

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

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
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.

@Puporev · 26.11.2013, 18:30

В данном коде много опечаток и неточностей, его нужно сначала исправить.

Добавлено через 25 минут
Хоть бы ссылку дали, где этот код содрали. Если конечно это не форум.(кроме нашего)

@Ksenia S · 26.11.2013, 18:38 **[ТС]**

Код взяла из книги Могилев, Пак, Хеннер "Информатика", страница 603

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
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.

@Puporev · 26.11.2013, 18:46

Ну и что Вы исправили? Я хочу видеть нормальный рабочий код в Турбо Паскаль, тогда перепишу в АВС. А так вместо букв H,K стоят русские буквы и другие ошибки.

@Ksenia S · 26.11.2013, 18:56 **[ТС]**

Procedure Runge_Kut (N: Integer; Var X: Real; Y0: G; Var Y: G; Н : Real);

Извините, но программа выдает ошибку " ожидалась закрывающая скобка ) ", поэтому дальше не выполняется, и я не вижу ошибок.
К сожалению, совсем не разбираюсь в Турбо Паскале(

@Puporev · 26.11.2013, 19:49

Сообщение от Ksenia S

К сожалению, совсем не разбираюсь в Турбо Паскале(

Ну и не надо. А эту программу вам никто не перепишет в АВС, о причинах я уже писал.

Новые блоги и статьи Все статьи Все блоги /
Использование SDL3-callbacks вместо функции main() на Android, Desktop и WebAssembly 8Observer8 24.01.2026 Если вы откроете примеры для начинающих на официальном репозитории SDL3 в папке: examples, то вы увидите, что все примеры используют следующие четыре обязательные функции, а привычная функция main(). . .	моя боль iceja 24.01.2026 Выложила интерполяцию кубическими сплайнами www. iceja. net REST сервисы временно не работают, только через Web. Написала за 56 рабочих часов этот сайт с нуля. При помощи perplexity. ai PRO , при. . .	Модель сукцессии микоризы anaschu 24.01.2026 Решили писать научную статью с неким РОманом	http://iceja.net/ математические сервисы iceja 20.01.2026 Обновила свой сайт http:/ / iceja. net/ , приделала Fast Fourier Transform экстраполяцию сигналов. Однако предсказывает далеко не каждый сигнал (см ограничения http:/ / iceja. net/ fourier/ docs ). Также. . .
http://iceja.net/ сервер решения полиномов iceja 18.01.2026 Выкатила http:/ / iceja. net/ сервер решения полиномов (находит действительные корни полиномов методом Штурма). На сайте документация по API, но скажу прямо VPS слабенький и 200 000 полиномов. . .	Расчёт переходных процессов в цепи постоянного тока igorrr37 16.01.2026 / * Дана цепь(не выше 3-го порядка) постоянного тока с элементами R, L, C, k(ключ), U, E, J. Программа находит переходные токи и напряжения на элементах схемы классическим методом(1 и 2 з-ны. . .	Восстановить юзерскрипты Greasemonkey из бэкапа браузера damix 15.01.2026 Если восстановить из бэкапа профиль Firefox после переустановки винды, то список юзерскриптов в Greasemonkey будет пустым. Но восстановить их можно так. Для этого понадобится консольная утилита. . .	Сукцессия микоризы: основная теория в виде двух уравнений. anaschu 11.01.2026 https:/ / rutube. ru/ video/ 7a537f578d808e67a3c6fd818a44a5c4/

@Puporev Почетный модератор 64314 / 47610 / 32743 Регистрация: 18.05.2008 Сообщений: 115,168
	26.11.2013, 18:30
	В данном коде много опечаток и неточностей, его нужно сначала исправить. Добавлено через 25 минут Хоть бы ссылку дали, где этот код содрали. Если конечно это не форум.(кроме нашего) 0

@Puporev Почетный модератор 64314 / 47610 / 32743 Регистрация: 18.05.2008 Сообщений: 115,168
	26.11.2013, 18:46
	Ну и что Вы исправили? Я хочу видеть нормальный рабочий код в Турбо Паскаль, тогда перепишу в АВС. А так вместо букв H,K стоят русские буквы и другие ошибки. 0

@Ksenia S 0 / 0 / 0 Регистрация: 05.10.2013 Сообщений: 63
	26.11.2013, 18:56 [ТС]
	Procedure Runge_Kut (N: Integer; Var X: Real; Y0: G; Var Y: G; Н : Real); Извините, но программа выдает ошибку " ожидалась закрывающая скобка ) ", поэтому дальше не выполняется, и я не вижу ошибок. К сожалению, совсем не разбираюсь в Турбо Паскале( 0