Разработка программы поиска решения системы дифференциальных уравнений двумя методами: Рунге-Кутта и Рунге-Кутта-Мерсона (стр. 3 из 4)
 |
 |
Нет
5.4 Блок-схема подпрограммы–процедуры moymenu
5.5 Блок-схема подпрограммы–процедуры ur
 |
5.6 Блок-схема подпрограммы–функции f1
 |
5.7 Блок-схема подпрограммы– функции f2
 |
5.8 Блок-схема подпрограммы–процедуры CursorSize
5.9 Блок-схема подпрограммы–процедуры HiddeCursor
 |
5.10 Блок-схема подпрограммы–процедуры NormCursor
 |
5.9 Блок-схема подпрограммы–процедуры Spravka
 |
5.10 Блок-схема подпрограммы–процедуры Zastavka
 |
6. Текст исходной программы
program Kursovoy;
Uses CRT, DOS;
Const N=2;
Label 11;
Type
mas=Array[1..4] of String[60];
Const
menu:mas= ('Справка ',
'Метод Рунге-Кутта ',
'Метод Рунге-Кутта-Мерсона',
'Выход ' );
var
i,s,p:integer;
h,v,x,e1,e2,e3 : real;
y,w,k,f,e,a,c,d:array[1..10] of real;
j,d2:integer;
k2:byte;
stop:boolean;
eps,dx,dy,x0,y0:real;
f11,f22:real;
c1,kod,k10:Char;
pass:string;
ch:char;
function f1 (x1,y1,y2:real):real;
begin
f1:=y1+y2-x1*x1+x1-2;
end;
function f2(x1,y1,y2:real):real;
begin
f2:=-2*y1+4*y2+2*x1*x1-4*x1-7;
end;
procedure ur;
begin
f[1]:=f1(x,y[1],y[2]);
f[2]:=f2(x,y[1],y[2]);
end;
Procedure CursorSize(Size:word);
var
Regs: Registers;
begin
With Regs do
begin
AH:=$01;
CH:=Hi(size);
Cl:=Lo(Size);
intr($10,Regs);
end;
end;
procedure HiddeCursor;
begin
CursorSize($2000);
end;
Procedure NormCursor;
begin
CursorSize($0607);
end;
Procedure ramka (x1,y1,x2,y2:byte);
const
a=#201;
b=#205;
c=#187;
d=#186;
e=#188;
f=#200;
begin
TextColor(15);
TextBackground(4);
Clrscr;
GoToxy(x1,y1);
write(a);
for i:=x1+1 to x2-1 do write(b);
write(c);
for i:=y1+1 to y2-1 do
begin
gotoxy(x1,i);
write(d);
Gotoxy(x2,i);
write(d);
End;
GoToxy(x1,y2);
write(f);
for i:=x1+1 to x2-1 do write(b);
write(e);
End;
Procedure Okno(x1,y1,x2,y2,Fcolor,Tcolor:byte);
Begin
Clrscr;
TextMode(3);
HiddeCursor;
Ramka(x1,y1,x2,y2);
Window(x1+1,y1+1,x2-1,y2-1);
TextBackground(Fcolor);
TextColor(Tcolor);
Clrscr;
Gotoxy(1,1);
End;
Procedure Zastavka;
begin
Okno(1,1,79,23,3,15);
GoToXY(3,1);
writeln(' ');
Writeln(' Министерство образования Республики Беларусь');
Writeln(' Белорусский национальный технический университет');
GoToXY (1,6);
writeln(' Программа решения системы дифференциальных уравнений ');
writeln;
writeln;
writeln;
writeln;
writeln(' Курсовая работа ');
writeln(' по дисциплине "Информатика" ');
GoToXY(1,15);
Writeln(' Исполнитель: Неверовская Я.Б') ;
writeln(' гр.102826 ');
writeln(' Руководитель: Петренко С.М.');
writeln;
writeln;
writeln(' Минск 2008');
Window(0,0,80,25);
gotoxy(40,23);
TextColor(15);
gotoxy(1,79);
writeln(' Для продолжения нажмите любую клавишу... ');
repeat until keypressed;
while keypressed do c1:=readkey;
clrscr;
End;
Procedure Spravka;
var
ch:char;
Begin
Okno(1,1,79,23,3,15);
Writeln(' СПРАВКА ' );
Writeln;
Writeln(' Данная программа позволяет найти решения системы дифференциальных уравнений. ') ;
Writeln(' В частности системы уравнений:');
Writeln(' y`1=y1+y2-x1*x1+x1-2 ');
Writeln(' y`2=-2*y1+4*y2+2*x1*x1-4*x1-7 ');
Writeln;
Writeln(' методом Рунге-Кутта или методом Рунге-Кутта-Мерсона. ') ;
Writeln(' Правые части системы дифференциальных уравнений заданы в подпрограммах ');
Writeln(' функциях f1 и f2 соответственно. В данных подпрограммах можно задать');
Writeln(' свои функции вместо исходных.');
Writeln(' После перехода в меню выберите клавишами управления курсора');
Writeln(' необходимый пункт.');
Writeln('При выборе пунктов меню "Метод Рунге-Кутта " или "Метод');
Writeln('Рунге-Кутта-Мерсона " введите исходные данные , программа выведет’);
writeln(' полученные результаты.');
Window(2,2,79,24);
Textcolor(15);
gotoxy(5,20);
write( ' Для возврата в меню нажмите любую клавишу... ' ) ;
ch:=readkey;
End;
Procedure moymenu;
begin
clrscr;
Okno(10,5,60,20,3,15);
For i:=1 to 4 do
begin
Gotoxy(15,i+5);
if i=p then Textbackground(4) else
Textbackground(3);
write(Menu[i]);
end;
End;
procedure Exitfrom;
begin
writeln;
gotoxy(50,26);
Writeln(' Для прдолжения вычисления нажмите Y, для выхода -N');
ch:=readkey;
if ch=#121 then moymenu else Zastavka;
end;
Procedure runkut ;
label 2;
begin
clrscr;
textcolor(15);
NormCursor;
Writeln('Метод Рунге-Кутта ');
2: Write('Задайте положительный начальный h=');
read(h);
if h<=0 then
goto 2
else begin
write ('Задайте начальное Xo=');
read (x);
for j:=1 to n do
begin
Write('Задайте начальные y0[',j,']=');
readln(W[j]);
y[j]:=W[j];
end;
ur;
for j:=1 to n do
begin
v:=H*f[j];
k[j]:=v;
y[j]:=W[j]+v/2;
end;
ur;
for j:=1 to n do
begin
v:=H*f[j];
k[j]:=k[j]+2*v;
y[j]:=W[j]+v/2;
end;
ur;
for j:=1 to n do
begin
v:=H*f[j];
k[j]:=k[j]+2*v;
y[j]:=W[j]+v;
end;
ur;
Textcolor(5);
Writeln('решение системы дифференциальных уравнений:');
for j:=1 to n do
begin
y[j]:=W[j]+(k[j]+h*f[j])/6;
writeln('y[',j,']=',y[j]:12:9);
W[j]:=y[j];
end;
HiddeCursor;
textcolor(14);
gotoxy(1,24);
writeln('Для продолжения вычисления нажмите <Y>,');
writeln('для выхода <N>');
ch:=readkey;
if ch=#121 then runkut else moymenu;
end;end;
Procedure rukutm;
label 3;
begin
clrscr;
textcolor(15);
NormCursor;
Writeln('Метод Рунге-Кутта-Мерсона ');
3: Write('задайте положительный начальный шаг h=');
read(h);
if h<=0 then
goto 3
else begin
Write('Задайте погрешность вычислений e=');
read(e1);
write ('Задайте начальное Xo=');
read (x);
for j:=1 to n do
begin
write('Введите начальное Y0[',j,']=');
readln(w[j]);
y[j]:=W[j];
end;
k2:=0;
e3:=0;
ur;
d2:=0;
for j:=1 to n do
begin
a[j]:=f[j]*H;
y[j]:=W[j]+a[j]/3;
end;
x:=x+h/3;
ur;
for j:=1 to n do
begin
y[j]:=W[j]+(a[j]+f[j]*H)/6;
end;
ur;
for j:=1 to n do
begin
c[j]:=f[j]*H;
y[j]:=W[j]+a[j]/8+0.375*c[j];
end;
x:=x+h/6;
ur;
for j:=1 to n do
begin
d[j]:=f[j]*H;
y[j]:=W[j]+a[j]/2-1.5*c[j]+2*d[j];
end;
x:=x+h/2;
ur;
for j:=1 to n do
begin
e[j]:=f[j]*H;
y[j]:=W[j]+(a[j]+4*d[j]+e[j])/6;
e2:=abs(-2*a[j]+9*c[j]-8*d[j]+e[j])/30;
if e2<=e1 then
if e2<e1/20 then d2:=d2+1 else
e3:=0;
end;
if e3<>0 then begin
x:=x-h;
for j:=1 to n do begin
y[j]:=W[j];
end;
H:=H/2;
end
else k2:=1;
if d2=n then H:=H+H;
Textcolor(5);
Writeln('решение системы дифференциальных уравнений:');
for i:=1 to n do begin
writeln('y[',i,']=',y[i]:12:9);
W[i]:=y[i];
end;
HiddeCursor;
textcolor(14);
gotoxy(1,24);
writeln('Для продолжения вычисления нажмите <Y>,');
writeln('для выхода <N>');
ch:=readkey;
if ch=#121 then rukutm else moymenu;
end; end;
BEGIN
Clrscr;
Zastavka;
11: hiddecursor;
p:=1;
moymenu;
k10:=readkey;
while k10<>#13 do
begin
Case k10 of
#72: if p=1 then p:=4 else p:=P-1;
#80: if p=4 then p:=1 else p:=p+1;
end;
moymenu;
k10:=readkey;
end;
Case p of
1: Spravka;
2: runkut;
3: rukutm;
4: exit;
end;
goto 11;
END.
7. Результаты работы программы
После запуска программы в соответствии с поставленной задачей на проектирование выводится окно заставки программы, приведенное на рисунке 1.
Рисунок 1. Окно заставки.
После нажатия любой клавиши выводится окно с меню, представленное на рисунке 2.
Рисунок 2. Окно с меню.
При выборе пункта меню «Справка» открывается соответствующие окно в котором находится справочная информация о программе. Пример такого окна представлен на рисунке 3.
Рисунок 3. Окно справки.
При выборе пункта меню « Метод Рунге-Кутта » или «Метод Рунге-Кутта-Мерсона» открывается соответствующие окна, в которых вводятся исходные данные и выводятся результаты вычисления. Примеры таких окон представлены на рисунках 4 ( Метод Рунге-Кутта ) и 5 (Метод Рунге-Кутта-Мерсона).
Рисунок 4. Вычисление методом Рунге-Кутта.
Рисунок 5. Вычисление методом Рунге-Кутта-Мерсона.